Tcl Source Code

Artifact 84aa7329cdfbe42adce29be7e358bc85c01d564c:

Attachment "tclMain.patch" to ticket [3124683fff] added by nijtmans 2010-12-01 23:19:12.

---

Index: generic/tclMain.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclMain.c,v
retrieving revision 1.57
diff -u -r1.57 tclMain.c
--- generic/tclMain.c	15 Nov 2010 10:12:38 -0000	1.57
+++ generic/tclMain.c	1 Dec 2010 15:57:52 -0000
@@ -47,23 +47,24 @@
 #   define TCHAR char
 #   define TEXT(arg) arg
 #   define _tcscmp strcmp
-#   define _tcslen strlen
-#   define _tcsncmp strncmp
 #endif
 
 /*
- * Further on, in UNICODE mode, we need to use functions like
- * Tcl_GetUnicodeFromObj, while otherwise Tcl_GetStringFromObj
- * is needed. Those macro's assure that the right functions
- * are used depending on the mode.
- */
-#ifndef UNICODE
-#   undef Tcl_GetUnicodeFromObj
-#   define Tcl_GetUnicodeFromObj Tcl_GetStringFromObj
-#   undef Tcl_NewUnicodeObj
-#   define Tcl_NewUnicodeObj Tcl_NewStringObj
-#   undef Tcl_WinTCharToUtf
-#   define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
+ * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
+ * while otherwise NewNativeObj is needed (which provides proper
+ * conversion from native encoding to UTF-8).
+ */
+#ifdef UNICODE
+#   define NewNativeObj Tcl_NewUnicodeObj
+#else /* !UNICODE */
+static Tcl_Obj *NewNativeObj(char *string, int length) {
+	Tcl_Obj *obj;
+	Tcl_DString ds;
+	Tcl_ExternalToUtfDString(NULL, string, length, &ds);
+	obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
+	Tcl_DStringFree(&ds);
+	return obj;
+}
 #endif /* !UNICODE */
 
 /*
@@ -296,13 +297,12 @@
 				 * but before starting to execute commands. */
     Tcl_Interp *interp)
 {
-    Tcl_Obj *path, *resultPtr, *argvPtr, *commandPtr = NULL;
+    Tcl_Obj *path, *resultPtr, *argvPtr, *appName, *commandPtr = NULL;
     const char *encodingName = NULL;
     PromptType prompt = PROMPT_START;
     int code, length, tty, exitCode = 0;
     Tcl_MainLoopProc *mainLoopProc;
     Tcl_Channel inChannel, outChannel, errChannel;
-    Tcl_DString appName;
 
     Tcl_InitMemory(interp);
 
@@ -322,13 +322,13 @@
 
 	if ((argc > 3) && (0 == _tcscmp(TEXT("-encoding"), argv[1]))
 		&& (TEXT('-') != argv[3][0])) {
-		Tcl_Obj *value = Tcl_NewUnicodeObj(argv[2], -1);
-	    Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[3], -1), Tcl_GetString(value));
+		Tcl_Obj *value = NewNativeObj(argv[2], -1);
+	    Tcl_SetStartupScript(NewNativeObj(argv[3], -1), Tcl_GetString(value));
 	    Tcl_DecrRefCount(value);
 	    argc -= 3;
 	    argv += 3;
 	} else if ((argc > 1) && (TEXT('-') != argv[1][0])) {
-	    Tcl_SetStartupScript(Tcl_NewUnicodeObj(argv[1], -1), NULL);
+	    Tcl_SetStartupScript(NewNativeObj(argv[1], -1), NULL);
 	    argc--;
 	    argv++;
 	}
@@ -336,16 +336,11 @@
 
     path = Tcl_GetStartupScript(&encodingName);
     if (path == NULL) {
-	Tcl_WinTCharToUtf(argv[0], -1, &appName);
+	appName = NewNativeObj(argv[0], -1);
     } else {
-	const TCHAR *pathName = Tcl_GetUnicodeFromObj(path, &length);
-
-	Tcl_WinTCharToUtf(pathName, length * sizeof(TCHAR), &appName);
-	path = Tcl_NewStringObj(Tcl_DStringValue(&appName), -1);
-	Tcl_SetStartupScript(path, encodingName);
+	appName = path;
     }
-    Tcl_SetVar(interp, "argv0", Tcl_DStringValue(&appName), TCL_GLOBAL_ONLY);
-    Tcl_DStringFree(&appName);
+    Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
     argc--;
     argv++;
 
@@ -353,12 +348,7 @@
 
     argvPtr = Tcl_NewListObj(0, NULL);
     while (argc--) {
-	Tcl_DString ds;
-
-	Tcl_WinTCharToUtf(*argv++, -1, &ds);
-	Tcl_ListObjAppendElement(NULL, argvPtr, Tcl_NewStringObj(
-		Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
-	Tcl_DStringFree(&ds);
+	Tcl_ListObjAppendElement(NULL, argvPtr, NewNativeObj(*argv++, -1));
     }
     Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);