From a4f23e43240cacd74f2c10961ddd6ee145d92b53 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Tue, 21 Jun 2016 14:31:03 +0000
Subject: Start bringing Tk_Init up to date with facilities Tcl provides.

---
 generic/tkWindow.c | 41 ++++++++++++++---------------------------
 tests/safe.test    |  2 +-
 2 files changed, 15 insertions(+), 28 deletions(-)

diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index b5cbbab..9405a05 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -3084,7 +3084,7 @@ Initialize(
 	 * master.
 	 */
 
-	Tcl_DString ds;
+	Tcl_Obj *cmd;
 
 	/*
 	 * Step 1 : find the master and construct the interp name (could be a
@@ -3095,7 +3095,7 @@ Initialize(
 
 	Tcl_Interp *master = interp;
 
-	while (1) {
+	while (Tcl_IsSafe(master)) {
 	    master = Tcl_GetMaster(master);
 	    if (master == NULL) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -3104,10 +3104,6 @@ Initialize(
 		code = TCL_ERROR;
 		goto done;
 	    }
-	    if (!Tcl_IsSafe(master)) {
-		/* Found the trusted master. */
-		break;
-	    }
 	}
 
 	/*
@@ -3116,39 +3112,30 @@ Initialize(
 
 	code = Tcl_GetInterpPath(master, interp);
 	if (code != TCL_OK) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "error in Tcl_GetInterpPath", -1));
-	    Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL);
-	    goto done;
+	    Tcl_Panic("Tcl_GetInterpPath broken!");
 	}
 
 	/*
-	 * Build the string to eval.
+	 * Build the command to eval in trusted master.
 	 */
 
-	Tcl_DStringInit(&ds);
-	Tcl_DStringAppendElement(&ds, "::safe::TkInit");
-	Tcl_DStringAppendElement(&ds, Tcl_GetString(Tcl_GetObjResult(master)));
-
+	cmd = Tcl_NewListObj(2, NULL);
+	Tcl_ListObjAppendElement(NULL, cmd,
+		Tcl_NewStringObj("::safe::TkInit", -1));
+	Tcl_ListObjAppendElement(NULL, cmd, Tcl_GetObjResult(master));
+	
 	/*
 	 * Step 2 : Eval in the master. The argument is the *reversed* interp
 	 * path of the slave.
 	 */
 
-	code = Tcl_EvalEx(master, Tcl_DStringValue(&ds), -1, 0);
+	Tcl_IncrRefCount(cmd);
+	code = Tcl_EvalObjEx(master, cmd, 0);
+	Tcl_DecrRefCount(cmd);
+	Tcl_TransferResult(master, code, interp);
 	if (code != TCL_OK) {
-	    /*
-	     * We might want to transfer the error message or not. We don't.
-	     * (No API to do it and maybe security reasons).
-	     */
-
-	    Tcl_DStringFree(&ds);
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "not allowed to start Tk by master's safe::TkInit", -1));
-	    Tcl_SetErrorCode(interp, "TK", "SAFE", "FAILED", NULL);
 	    goto done;
 	}
-	Tcl_DStringFree(&ds);
 
 	/*
 	 * Use the master's result as argv. Note: We don't use the Obj
@@ -3156,7 +3143,7 @@ Initialize(
 	 * changing the code below.
 	 */
 
-	argString = Tcl_GetString(Tcl_GetObjResult(master));
+	argString = Tcl_GetString(Tcl_GetObjResult(interp));
     } else {
 	/*
 	 * If there is an "argv" variable, get its value, extract out relevant
diff --git a/tests/safe.test b/tests/safe.test
index e7ed6c7..69a67ba 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -187,7 +187,7 @@ test safe-5.1 {loading Tk in safe interps without master's clearance} -body {
     interp eval $i {load {} Tk}
 } -cleanup {
     safe::interpDelete $i
-} -returnCodes error -result {not allowed to start Tk by master's safe::TkInit}
+} -returnCodes error -result {not allowed}
 test safe-5.2 {multi-level Tk loading with clearance} -setup {
     set safeParent [safe::interpCreate]
 } -body {
-- 
cgit v0.12