Tcl Source Code

Artifact [d487464803]
Login

Artifact d48746480357b6004ebbcfa1185739beb1576a09:

Attachment "403531.patch" to ticket [403551ffff] added by dgp 2001-04-07 00:53:26. Also attachment "403531.patch" to ticket [403531ffff] added by dgp 2001-04-04 08:11:11.
Index: doc/StaticPkg.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/StaticPkg.3,v
retrieving revision 1.3
diff -u -r1.3 StaticPkg.3
--- doc/StaticPkg.3	2000/04/14 23:01:54	1.3
+++ doc/StaticPkg.3	2001/04/04 01:05:39
@@ -24,8 +24,10 @@
 appropriate initialization procedure).  NULL means the package
 hasn't yet been incorporated into any interpreter.
 .AP char *pkgName in
-Name of the package;  should be properly capitalized (first letter
-upper-case, all others lower-case).
+.VS 8.4
+Name of the package.  Should be the same string as passed
+by \fIinitProc\fR and \fIsafeInitProc\fR to \fBTcl_PkgProvide\fR.
+.VE 8.4
 .AP Tcl_PackageInitProc *initProc in
 Procedure to invoke to incorporate this package into a trusted
 interpreter.
@@ -42,6 +44,30 @@
 has already been loaded into an interpreter.
 Once \fBTcl_StaticPackage\fR has been invoked for a package, it
 may be loaded into interpreters using the \fBload\fR command.
+.PP
+.VS 8.4
+If \fIinterp\fR is not NULL, \fBTcl_StaticPackage\fR will check
+that package \fIpkgName\fR has been provided in \fIinterp\fR.
+If package \fIpkgName\fR has not been provided in \fIinterp\fR,
+\fBTcl_StaticPackage\fR will do nothing.  When used properly,
+a call to one of the initialization procedures, either
+.CS
+(*initProc)(\fIinterp\fR)
+.CE
+or
+.CS
+(*safeInitProc)(\fIinterp\fR)
+.CE
+should precede the call to \fBTcl_StaticPackage\fR.  Then package
+\fIpkgName\fR will be provided in \fIinterp\fR, and
+\fBTcl_StaticPackage\fR will do its work.
+.PP
+If you must register an association between \fIpkgName\fR and
+\fIinitProc\fR and/or \fIsafeInitProc\fR without providing the
+package \fIpkgName\fR in any interpreter, then let \fIinterp\fR
+be NULL in your call to \fBTcl_StaticPackage\fR.
+.VE 8.4
+.PP
 \fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
 procedure for the application, not by packages for themselves
 (\fBTcl_StaticPackage\fR should only be invoked for statically
Index: doc/info.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/info.n,v
retrieving revision 1.6
diff -u -r1.6 info.n
--- doc/info.n	2001/03/13 15:10:32	1.6
+++ doc/info.n	2001/04/04 01:05:39
@@ -116,16 +116,22 @@
 See the \fBtclvars\fR manual entry for more information.
 .TP
 \fBinfo loaded \fR?\fIinterp\fR?
-Returns a list describing all of the packages that have been loaded into
-\fIinterp\fR with the \fBload\fR command.
-Each list element is a sub-list with two elements consisting of the
-name of the file from which the package was loaded and the name of
-the package.
-For statically-loaded packages the file name will be an empty string.
-If \fIinterp\fR is omitted then information is returned for all packages
-loaded in any interpreter in the process.
-To get a list of just the packages in the current interpreter, specify
-an empty string for the \fIinterp\fR argument.
+.VS 8.4
+Returns a list describing all of the packages that have been successfully
+provided in \fIinterp\fR by prior evaluations of the \fBload\fR command,
+and all statically-loaded packages provided in \fIinterp\fB that have been
+registered by prior calls to \fBTcl_StaticPackage\fR.  Each element of the
+returned list is a sub-list with two elements consisting of the name of
+the file from which the package was loaded and the name of the package
+provided when that file was loaded.  For statically-loaded packages the
+file name is an empty string.  To get a list of just the packages in the
+current interpreter, specify an empty string for the \fIinterp\fR argument.
+If \fIinterp\fR is omitted entirely, then the returned list of pairs
+includes all filenames loaded by prior evaluations of \fBload\fR and
+all package names previously registered with Tcl_StaticPackage() in any
+interpreter, or in no interpreter at all, regardless of whether any package
+was successfully provided in any interpreter.
+.VE 8.4
 .TP
 \fBinfo locals \fR?\fIpattern\fR?
 If \fIpattern\fR isn't specified, returns a list of all the names
@@ -200,4 +206,4 @@
 
 '\" Local Variables:
 '\" mode: nroff
-'\" End:
\ No newline at end of file
+'\" End:
Index: doc/load.n
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/load.n,v
retrieving revision 1.6
diff -u -r1.6 load.n
--- doc/load.n	2000/09/07 14:27:49	1.6
+++ doc/load.n	2001/04/04 01:05:39
@@ -65,8 +65,10 @@
 package is to be loaded.  The initialization procedure must return
 \fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
 successfully;  in the event of an error it should set the interpreter's result
-to point to an error message.  The result of the \fBload\fR command
-will be the result returned by the initialization procedure.
+.VS 8.4
+to an error message.  The result of the \fBload\fR command will be the
+.VE 8.4
+result returned by the initialization procedure.
 .PP
 The actual loading of a file will only be done once for each \fIfileName\fR
 in an application.  If a given \fIfileName\fR is loaded into multiple
@@ -87,13 +89,15 @@
 The default guess, which is used on most UNIX platforms, is to
 take the last element of \fIfileName\fR, strip off the first
 three characters if they are \fBlib\fR, and use any following
-.VS
-alphabetic and underline characters as the module name.
-.VE
-For example, the command \fBload libxyz4.2.so\fR uses the module
-name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
-module name \fBlast\fR.
-.VS "" br
+.VS 8.4
+alphabetic and underline characters to create the package name.
+Finally the extracted alphabetic and underline characters have
+their case converted in the same manner used to determine the
+name of the initialization procedure.
+For example, the command \fBload libxyz4.2.so\fR uses the package
+name \fBXyz\fR and the command \fBload bin/last.so {}\fR uses the
+package name \fBLast\fR.
+.VE 8.4
 .PP
 If \fIfileName\fR is an empty string, then \fIpackageName\fR must
 be specified.
@@ -104,7 +108,6 @@
 package by that name, and uses it if it is found.  If several
 different files have been \fBload\fRed with different versions of
 the package, Tcl picks the file that was loaded first.
-.VE
 
 .SH "PORTABILITY ISSUES"
 .TP
Index: generic/tclLoad.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLoad.c,v
retrieving revision 1.4
diff -u -r1.4 tclLoad.c
--- generic/tclLoad.c	1999/12/01 00:08:28	1.4
+++ generic/tclLoad.c	2001/04/04 01:05:39
@@ -27,9 +27,7 @@
 				 * package was loaded.  An empty string
 				 * means the package is loaded statically.
 				 * Malloc-ed. */
-    char *packageName;		/* Name of package prefix for the package,
-				 * properly capitalized (first letter UC,
-				 * others LC), no "_", as in "Net". 
+    char *packageName;		/* Name of package.
 				 * Malloc-ed. */
     ClientData clientData;	/* Token for the loaded file which should be
 				 * passed to TclpUnloadFile() when the file
@@ -68,7 +66,7 @@
  * The following structure represents a particular package that has
  * been incorporated into a particular interpreter (by calling its
  * initialization procedure).  There is a list of these structures for
- * each interpreter, with an AssocData value (key "load") for the
+ * each interpreter, with an AssocData value (key "tclLoad") for the
  * interpreter that points to the first package (if any).
  */
 
@@ -161,7 +159,8 @@
 	slaveIntName = Tcl_GetString(objv[3]);
 	target = Tcl_GetSlave(interp, slaveIntName);
 	if (target == NULL) {
-	    return TCL_ERROR;
+	    code = TCL_ERROR;
+	    goto done;
 	}
     }
 
@@ -169,10 +168,14 @@
      * Scan through the packages that are currently loaded to see if the
      * package we want is already loaded.  We'll use a loaded package if
      * it meets any of the following conditions:
-     *  - Its name and file match the once we're looking for.
+     *  - Its name and file match the one we're looking for.
      *  - Its file matches, and we weren't given a name.
-     *  - Its name matches, the file name was specified as empty, and there
-     *    is only no statically loaded package with the same name.
+     *  - Its name matches, the file name was specified as empty, and the
+     *    loaded package was the first of all those loaded with the same
+     *    name.  Since statically loaded packages are loaded using
+     *    Tcl_StaticPackage() during application startup, a statically
+     *    loaded package is preferred over all dynamically loaded 
+     *    packages with the same name.
      */
     Tcl_MutexLock(&packageMutex);
 
@@ -185,8 +188,6 @@
 	    Tcl_DStringAppend(&pkgName, packageName, -1);
 	    Tcl_DStringSetLength(&tmp, 0);
 	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
-	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
-	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
 	    if (strcmp(Tcl_DStringValue(&tmp),
 		    Tcl_DStringValue(&pkgName)) == 0) {
 		namesMatch = 1;
@@ -300,26 +301,31 @@
 		}
 		Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess));
 		ckfree((char *)pargv);
+
+		/*
+		 * Normalize the guessed package name to have the
+		 * capitalization expected for the prefix of the
+		 * initialization procedures.
+		 */
+
+		Tcl_DStringSetLength(&pkgName,
+			Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
 	    }
 	}
 
-	/*
-	 * Fix the capitalization in the package name so that the first
-	 * character is in caps (or title case) but the others are all
-	 * lower-case.
-	 */
-    
-	Tcl_DStringSetLength(&pkgName,
-		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));
-
 	/*
-	 * Compute the names of the two initialization procedures,
-	 * based on the package name.
+	 * Compute the names of the two initialization procedures.
+	 * The common prefix for the names of both initialization
+	 * procedures is derived from the package name by forcing
+	 * the first character to upper case and all other characters
+	 * to lower case.  The package name itself is not changed.
 	 */
     
 	Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1);
+	Tcl_DStringSetLength(&initName,
+		Tcl_UtfToTitle(Tcl_DStringValue(&initName)));
+	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&initName), -1);
 	Tcl_DStringAppend(&initName, "_Init", 5);
-	Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1);
 	Tcl_DStringAppend(&safeInitName, "_SafeInit", 9);
 
 	/*
@@ -373,9 +379,13 @@
 	if (pkgPtr->safeInitProc != NULL) {
 	    code = (*pkgPtr->safeInitProc)(target);
 	} else {
+	    Tcl_DStringSetLength(&tmp, 0);
+	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
+	    Tcl_DStringSetLength(&tmp,
+		    Tcl_UtfToTitle(Tcl_DStringValue(&tmp)));
 	    Tcl_AppendResult(interp,
 		    "can't use package in a safe interpreter: ",
-		    "no ", pkgPtr->packageName, "_SafeInit procedure",
+		    "no ", Tcl_DStringValue(&tmp), "_SafeInit procedure",
 		    (char *) NULL);
 	    code = TCL_ERROR;
 	    goto done;
@@ -385,27 +395,45 @@
     }
 
     /*
-     * Record the fact that the package has been loaded in the
-     * target interpreter.
+     * If the initialization procedure failed, return the error
+     * message, and don't register the load in the target interp.
      */
 
-    if (code == TCL_OK) {
-	/*
-	 * Refetch ipFirstPtr: loading the package may have introduced
-	 * additional static packages at the head of the linked list!
-	 */
-
-	ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
-		(Tcl_InterpDeleteProc **) NULL);
-	ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
-	ipPtr->pkgPtr = pkgPtr;
-	ipPtr->nextPtr = ipFirstPtr;
-	Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
-		(ClientData) ipPtr);
-    } else {
+    if (code != TCL_OK) {
 	TclTransferResult(target, code, interp);
+	goto done;
+    }
+
+    /*
+     * If the initialization procedure did not provide the package we
+     * associate with loading the file, do not register that package
+     * as one loaded in target for later return by [info loaded target].
+     */
+
+    if ((Tcl_PkgPresent(target, pkgPtr->packageName, NULL, 0) == NULL) ) {
+	if (target == interp) {
+	    Tcl_ResetResult(interp);
+	}
+        code = TCL_OK;
+        goto done;
     }
 
+    /*
+     * Record the fact that the package has been loaded in the
+     * target interpreter.
+     *
+     * Refetch ipFirstPtr: loading the package may have introduced
+     * additional static packages at the head of the linked list!
+     */
+
+    ipFirstPtr = (InterpPackage *) Tcl_GetAssocData(target, "tclLoad",
+	    (Tcl_InterpDeleteProc **) NULL);
+    ipPtr = (InterpPackage *) ckalloc(sizeof(InterpPackage));
+    ipPtr->pkgPtr = pkgPtr;
+    ipPtr->nextPtr = ipFirstPtr;
+    Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc,
+	    (ClientData) ipPtr);
+
     done:
     Tcl_DStringFree(&pkgName);
     Tcl_DStringFree(&initName);
@@ -439,9 +467,7 @@
 					 * package has already been loaded
 					 * into the given interpreter by
 					 * calling the appropriate init proc. */
-    char *pkgName;			/* Name of package (must be properly
-					 * capitalized: first letter upper
-					 * case, others lower case). */
+    char *pkgName;			/* Name of package */
     Tcl_PackageInitProc *initProc;	/* Procedure to call to incorporate
 					 * this package into a trusted
 					 * interpreter. */
@@ -454,6 +480,18 @@
 {
     LoadedPackage *pkgPtr;
     InterpPackage *ipPtr, *ipFirstPtr;
+
+    /*
+     * When used properly, Tcl_StaticPackage() should be called only
+     * after the appropriate init proc has been called to provide
+     * pkgName in interp.  If package pkgName has not been provided
+     * in interp, return immediately.  Do not register a false claim
+     * that package pkgName is loaded in interp.
+     */
+
+    if (interp != NULL && Tcl_PkgPresent(interp, pkgName, NULL, 0) == NULL) {
+	return;
+    }
 
     /*
      * Check to see if someone else has already reported this package as
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.24
diff -u -r1.24 tclTest.c
--- generic/tclTest.c	2001/03/31 01:55:37	1.24
+++ generic/tclTest.c	2001/04/04 01:05:40
@@ -49,6 +49,13 @@
 static Tcl_Interp *delInterp;
 
 /*
+ * Dynamic string shared by TeststaticpkgCmd and StaticInitProc; used
+ * to covertly pass the package name.
+ */
+
+static Tcl_DString packageName;
+
+/*
  * One of the following structures exists for each asynchronous
  * handler created by the "testasync" command".
  */
@@ -3053,6 +3060,11 @@
     if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
 	return TCL_ERROR;
     }
+    Tcl_DStringInit(&packageName);
+    Tcl_DStringAppend(&packageName, argv[1], -1);
+    if (loaded) {
+	StaticInitProc(interp);
+    }
     Tcl_StaticPackage((loaded) ? interp : NULL, argv[1], StaticInitProc,
 	    (safe) ? StaticInitProc : NULL);
     return TCL_OK;
@@ -3063,6 +3075,7 @@
     Tcl_Interp *interp;			/* Interpreter in which package
 					 * is supposedly being loaded. */
 {
+    Tcl_PkgProvide(interp, Tcl_DStringValue(&packageName), "0");
     Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
     return TCL_OK;
 }
Index: tests/load.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/load.test,v
retrieving revision 1.7
diff -u -r1.7 load.test
--- tests/load.test	2000/04/10 17:19:01	1.7
+++ tests/load.test	2001/04/04 01:05:40
@@ -66,9 +66,9 @@
     list [pkga_eq abc def] [info commands pkga_*]
 } {0 {pkga_eq pkga_quote}}
 interp create -safe child
-test load-2.2 {loading into a safe interpreter, with package name conversion} \
+test load-2.2 {loading into a safe interpreter, with explicit package name} \
 	[list $dll $loaded] {
-    load [file join $testDir pkgb$ext] pKgB child
+    load [file join $testDir pkgb$ext] Pkgb child
     list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
 	    [catch {pkgb_sub 12 10} msg2] $msg2
 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
@@ -109,22 +109,35 @@
 "load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
 
 test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
-    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+    list [catch {load [file join $testDir pkga$ext] Pkga} msg] $msg
 } {0 {}}
 test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
     list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
 } "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}"
+test load-4.3 {reloading package into same interpreter} [list $dll $loaded] {
+    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+} "1 {file \"[file join $testDir pkga$ext\"] is already loaded for package \"Pkga\"}" 
 
 test load-5.1 {file name not specified and no static package: pick default} \
 	[list $dll $loaded] {
     catch {interp delete x}
     interp create x
-    load [file join $testDir pkga$ext] pkga
-    load {} pkga x
+    load [file join $testDir pkga$ext] Pkga
+    load {} Pkga x
     set result [info loaded x]
     interp delete x
     set result
 } "{[file join $testDir pkga$ext] Pkga}"
+test load-5.2 {file name not specified and no matching package} \
+	[list $dll $loaded] {
+    catch {interp delete x}
+    interp create x
+    load [file join $testDir pkga$ext] Pkga
+    set result [list [catch {load {} pkga x} msg] $msg]
+    lappend result [info loaded x]
+    interp delete x
+    set result
+} {1 {package "pkga" isn't loaded statically} {}}
 
 # On some platforms, like SunOS 4.1.3, these tests can't be run because
 # they cause the process to exit.
@@ -132,9 +145,26 @@
 test load-6.1 {errors loading file} [list $dll $loaded nonPortable] {
     catch {load foo foo}
 } {1}
+test load-6.2 {_Init procedure fails to provide package} {
+    list [catch {load [file join $testDir pkgd$ext] Pkgd} msg] $msg
+} {0 {}}
+test load-6.3 {_SafeInit procedure fails to provide package} {
+    list [catch {load {} Pkgd child} msg] $msg
+} {0 {}}
+# Possible future behavior:
+#test load-6.2 {_Init procedure fails to provide package} {
+#    list [catch {load [file join $testDir pkgd$ext] Pkgd} msg] $msg
+#} "1 {loading \"[file join $testDir pkgd$ext]\" did not provide package \"Pkgd\"}"
+#test load-6.3 {_SafeInit procedure fails to provide package} {
+#    list [catch {load {} Pkgd child} msg] $msg
+#} "1 {loading \"\" did not provide package \"Pkgd\" in child}"
+
+
 
 if {[info command teststaticpkg] != ""} {
     test load-7.1 {Tcl_StaticPackage procedure} [list $dll $loaded] {
+	# Test that _Init and _SafeInit routine registered by
+	# Tcl_StaticPackge() get called by [load]
 	set x "not loaded"
 	teststaticpkg Test 1 0
 	load {} Test
@@ -142,6 +172,8 @@
 	list [set x] [child eval set x]
     } {loaded loaded}
     test load-7.2 {Tcl_StaticPackage procedure} [list $dll $loaded] {
+	# Test that Tcl_StaticPackage does not register a _SafeInit routine
+	# => can't load into safe interp.
 	set x "not loaded"
 	teststaticpkg Another 0 0
 	load {} Another
@@ -150,21 +182,34 @@
 		[child eval set x] [set x]
     } {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
     test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] {
+	# Test that [load {}] does not call _Init for package already
+	# statically loaded in the interp.
 	set x "not loaded"
 	teststaticpkg More 0 1
+	set result $x
+	set x "not loaded"
 	load {} More
-	set x
-    } {not loaded}
+	list $result $x
+    } {loaded {not loaded}}
     test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
 	    [list $dll $loaded] {
+	# Test that redundant calls to Tcl_StaticPackage() do not cause
+	# [info loaded {}] to list the package twice.
 	teststaticpkg Double 0 1
 	teststaticpkg Double 0 1
-	info loaded
-    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+	info loaded {}
+    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+    test load-7.5 {Tcl_StaticPackage procedure, non-provided package} \
+	    [list $dll $loaded] {
+	# Test that calls to Tcl_StaticPackage() do not cause
+	# [info loaded {}] to list a package not present in the interp.
+	teststaticpkg Invalid 0 0
+	info loaded {}
+    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
 
     test load-8.1 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	info loaded
-    } "{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkge$ext] Pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
+    } "{{} Invalid} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkgd$ext] Pkgd} {[file join $testDir pkge$ext] pkge} {[file join $testDir pkgb$ext] Pkgb} {[file join $testDir pkga$ext] Pkga} $alreadyTotalLoaded"
     test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] {
 	list [catch {info loaded gorp} msg] $msg
     } {1 {could not find interpreter "gorp"}}
@@ -172,7 +217,7 @@
 	list [info loaded {}] [info loaded child]
     } "{{{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {{{} Test} {[file join $testDir pkgb$ext] Pkgb}}"
     test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded] {
-	load [file join $testDir pkgb$ext] pkgb
+	load [file join $testDir pkgb$ext] Pkgb
 	list [info loaded {}] [lsort [info commands pkgb_*]]
     } "{{[file join $testDir pkgb$ext] Pkgb} {{} Double} {{} More} {{} Another} {{} Test} {[file join $testDir pkga$ext] Pkga} $alreadyLoaded} {pkgb_sub pkgb_unsafe}"
     interp delete child
Index: unix/dltest/pkgd.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/dltest/pkgd.c,v
retrieving revision 1.4
diff -u -r1.4 pkgd.c
--- unix/dltest/pkgd.c	2000/04/04 08:06:07	1.4
+++ unix/dltest/pkgd.c	2001/04/04 01:05:40
@@ -117,10 +117,15 @@
     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
 	return TCL_ERROR;
     }
+/*
+ * We forget to provide the package "Pkgd"
+ *
     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
     if (code != TCL_OK) {
 	return code;
     }
+ *
+ */
     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd,
 	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
     Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd,
@@ -155,10 +160,15 @@
     if (Tcl_InitStubs(interp, TCL_VERSION, 1) == NULL) {
 	return TCL_ERROR;
     }
+/*
+ * We forget to provide the package "Pkgd"
+ *
     code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
     if (code != TCL_OK) {
 	return code;
     }
+ *
+ */
     Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, (ClientData) 0,
 	    (Tcl_CmdDeleteProc *) NULL);
     return TCL_OK;