Implement TCL_INIT_CREATE_UTF8/TCL_INIT_CREATE_UNICODE

5 files changed, 69 insertions, 29 deletions

diff --git a/ChangeLog b/ChangeLog
index 55bb874..1655e15 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,13 @@
+2013-01-09  Jan Nijtmans  <nijtmans@users.sf.net>
+
+	* library/http/http.tcl: [Bug 3599395]: http assumes status line
+	is a proper tcl list.
+
 2013-01-08  Jan Nijtmans  <nijtmans@users.sf.net>
 
 	* win/tclWinFile.c: [Bug 3092089]: [file normalize] can remove path
 	components.	[Bug 3587096] win vista/7: "can't find init.tcl" when
-	called via junction.
+	called via junction without folder list access.
 
 2013-01-07  Jan Nijtmans  <nijtmans@users.sf.net>
 
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index 216588c..4ad815f 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -27,8 +27,8 @@ Tcl_Interp *
 The first command-line argument to the program, which gives the
 application's name.
 .AP int flags in
-Any combination of TCL_INIT_PANIC or TCL_INIT_CREATE, which indicate
-whether a custom panicProc is registered and/or a real interpreter is created.
+Any combination of flags which indicate whether a custom panicProc
+is registered and/or a real interpreter is created.
 The value 0 can be used if Tcl is used as utility library only.
 .BE
 
@@ -79,35 +79,59 @@ load the Tcl shared library and use functions in it
 without ever creating an interpreter. E.g. the
 following code can be compiled with -DUSE_TCL_STUBS:
 .CS
-    handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
+    Tcl_Interp *interp, *(*initSubSystems)(int, ...)
+    const char *version;
+    void *handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
     initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
-    interp = initSubSystems(0); /* not a real interpreter */
-    Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */
-    interp = Tcl_CreateInterp(); /* now we have a real interpreter */
+    interp = initSubSystems(0); /* Not a real interpreter */
+    version = Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */
+    interp = Tcl_CreateInterp(); /* Now we have a real interpreter */
+    Tcl_InitStubs(interp, version, 0); /* Initialize the stub table again */
 .CE
 The function \fBTcl_CreateInterp\fR, or any other Tcl function you
 would like to call, no longer needs to be searched for in the
-shared library. It can be called directly though the stub table. 
+shared library. It can be called directly though the stub table.
+Note that the stub table needs to be initialized twice, in order
+to be sure that you can call all functions without limitations
+after the real interpreter is created.
 .PP
 If you supply the flag TCL_INIT_PANIC to \fBTcl_InitSubsystems\fR,
 the function expects an additional argument, a custom panicProc.
 This is equivalent to calling \fBTcl_SetPanicProc\fR immediately
-before \fBTcl_InitSubsystems\fR.
+before \fBTcl_InitSubsystems\fR, except that you possibly cannot do
+that yet if it requires an initialized stub table. Of course you
+could call \fBTcl_SetPanicProc\fR immediately after \fBTcl_InitSubsystems\fR,
+but then panics which could be produced by the initialization
+itself still use the default panic procedure. 
 .PP
-If you supply the flag TCL_INIT_CREATE to \fBTcl_InitSubsystems\fR,
-the function gets two additional parameters, argc and argv. A real
-Tcl interpreter will be created and if argc > 0 then the variables
-"argc" and "argv" will be set in this interpreter. So, the above
-example code could be simplified to:
+If you supply one of the flags TCL_INIT_CREATE, TCL_INIT_CREATE_UTF8 or
+TCL_INIT_CREATE_UNICODE to \fBTcl_InitSubsystems\fR, the function
+gets two additional parameters, argc and argv. Then a real
+Tcl interpreter will be created. If argc > 0 then the variables
+\fBargc\fR and \fBargv\fR will be set in this interpreter. The 3
+variants assume a different encoding for the arguments, except for
+\fIargv[0]\fR which is always assumed to be in the system encoding.
+So, the above example code could be simplified to:
 .CS
-    handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
+    Tcl_Interp *interp, *(*initSubSystems)(int, ...)
+    void *handle = dlopen("libtcl8.6.so", RTLD_NOW|RTLD_LOCAL);
     initSubSystems = dlsym(handle, "Tcl_InitSubsystems");
-    interp = initSubSystems(TCL_INIT_CREATE, 0, NULL); /* real interpreter */
+    interp = initSubSystems(TCL_INIT_CREATE, 0, NULL); /* Real interpreter */
     Tcl_InitStubs(interp, NULL, 0); /* initialize the stub table */
 .CE
 .PP
+The reason for argv0 always using the system encoding is that this way,
+argv0 can be derived directly from the main() (or mainw, on Windows)
+arguments without any processing. TCL_INIT_CREATE_UNICODE is really only
+useful on Windows. But on Windows, the argv0 parameter is not used for
+determining the value of [info executable] anyway. Modern UNIX system already
+have UTF-8 as system encoding, so TCL_INIT_CREATE_UTF8 would have the same
+effect as TCL_INIT_CREATE, only slightly faster. Other parameters can be
+preprocessed at will by the application, and if the application uses unicode
+or utf-8 internally there is no need to convert it back to the system encoding.
+.PP
 The interpreter returned by Tcl_InitSubsystems(0) cannot be passed to
 any other function than Tcl_InitStubs(). Tcl functions with an "interp"
-argument can only be called if this function supports passing NULL.
+argument can only be called if the function supports passing NULL.
 .SH KEYWORDS
 binary, executable file
diff --git a/generic/tcl.h b/generic/tcl.h
index 8a7911b..efe950e 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2412,7 +2412,9 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
 /* Tcl_InitSubsystems, see TIP ??? */
 
 #define TCL_INIT_PANIC (1) /* Set Panic proc */
-#define TCL_INIT_CREATE (4) /* Call Tcl_CreateInterp(), and set argc/argv */
+#define TCL_INIT_CREATE (48) /* Call Tcl_CreateInterp(), and set argc/argv */
+#define TCL_INIT_CREATE_UNICODE (16) /* The same, but argv is in unicode */
+#define TCL_INIT_CREATE_UTF8 (32) /* The same, but argv is in utf-8 */
 
 EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
 
@@ -2422,8 +2424,7 @@ EXTERN Tcl_Interp *Tcl_InitSubsystems(int flags, ...);
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    Tcl_InitSubsystems(TCL_INIT_CREATE, argc, argv))
-//	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 9a64f10..257089e 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -1446,7 +1446,7 @@ Tcl_InitSubsystems(int flags, ...)
     va_list argList;
 
     int argc = 0;
-    char **argv = NULL;
+    void **argv = NULL;
 
     va_start(argList, flags);
     if (flags & TCL_INIT_PANIC) {
@@ -1454,7 +1454,7 @@ Tcl_InitSubsystems(int flags, ...)
     }
     if (flags & TCL_INIT_CREATE) {
 	argc = va_arg(argList, int);
-	argv = va_arg(argList, char **);
+	argv = va_arg(argList, void **);
     }
     va_end (argList);
 
@@ -1463,18 +1463,28 @@ Tcl_InitSubsystems(int flags, ...)
     TclpFindExecutable(argv ? argv[0] : NULL);
     if (flags & TCL_INIT_CREATE) {
 	Tcl_Interp *interp = Tcl_CreateInterp();
-	if (argc > 0) {
+	if (--argc >= 0) {
 	    Tcl_Obj *argvPtr;
-	    argc--;
-	    argv++;
 
 	    Tcl_SetVar2Ex(interp, "argc", NULL, Tcl_NewIntObj(argc), TCL_GLOBAL_ONLY);
 	    argvPtr = Tcl_NewListObj(argc, NULL);
-	    while (argc--) {
+	    if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UTF8) {
+		while (argc--) {
+		    Tcl_ListObjAppendElement(NULL, argvPtr,
+			    Tcl_NewStringObj(*++argv, -1));
+		}
+	    } else if ((flags & TCL_INIT_CREATE) == TCL_INIT_CREATE_UNICODE) {
+		while (argc--) {
+		    Tcl_ListObjAppendElement(NULL, argvPtr,
+			    Tcl_NewUnicodeObj(*++argv, -1));
+		}
+	    } else {
 		Tcl_DString ds;
 
-		Tcl_ExternalToUtfDString(NULL, *argv++, -1, &ds);
-		Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds));
+		while (argc--) {
+		    Tcl_ExternalToUtfDString(NULL, *++argv, -1, &ds);
+		    Tcl_ListObjAppendElement(NULL, argvPtr, TclDStringToObj(&ds));
+		}
 	    }
 	    Tcl_SetVar2Ex(interp, "argv", NULL, argvPtr, TCL_GLOBAL_ONLY);
 	}
diff --git a/library/http/http.tcl b/library/http/http.tcl
index cb221a3..01bf772 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -981,7 +981,7 @@ proc http::Event {sock token} {
 	} elseif {$n == 0} {
 	    # We have now read all headers
 	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
-	    if {$state(http) == "" || [lindex $state(http) 1] == 100} {
+	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
 		return
 	    }