? trace.patch ? solaris ? load.patch ? tcl84a1load.txt ? unix/configure ? unix/config.log ? unix/config.cache ? unix/config.status ? unix/Makefile ? unix/tclConfig.sh ? unix/tclsh ? unix/tcltest ? unix/dltest/configure ? unix/dltest/config.log ? unix/dltest/config.cache ? unix/dltest/config.status ? unix/dltest/Makefile ? win/configure Index: doc/StaticPkg.3 =================================================================== RCS file: /cvsroot/tcl/doc/StaticPkg.3,v retrieving revision 1.3 diff -c -r1.3 StaticPkg.3 *** StaticPkg.3 2000/04/14 23:01:54 1.3 --- StaticPkg.3 2000/07/22 01:22:20 *************** *** 24,31 **** 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). .AP Tcl_PackageInitProc *initProc in Procedure to invoke to incorporate this package into a trusted interpreter. --- 24,31 ---- 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 the same string as passed ! by \fIinitProc\fR and \fIsafeInitProc\fR to \fBTcl_PkgProvide\fR. .AP Tcl_PackageInitProc *initProc in Procedure to invoke to incorporate this package into a trusted interpreter. *************** *** 42,47 **** --- 42,64 ---- 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 + 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 \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 *************** *** 59,69 **** .CE The \fIinterp\fR argument identifies the interpreter in which the 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 or error from the initialization procedure will ! be returned as the result of the \fBload\fR command that caused the ! initialization procedure to be invoked. .SH KEYWORDS initialization procedure, package, static linking --- 76,88 ---- .CE The \fIinterp\fR argument identifies the interpreter in which the 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, which will be returned as the result of the \fBload\fR ! command that caused the initialization procedure to be invoked. If ! the initialization procedure completes successfully, it must provide ! the package \fIpkgName\fR. If it fails to do so, an error message ! reporting that failure will be returned as the result of \fBload\fR. .SH KEYWORDS initialization procedure, package, static linking Index: doc/info.n =================================================================== RCS file: /cvsroot/tcl/doc/info.n,v retrieving revision 1.4 diff -c -r1.4 info.n *** info.n 2000/05/27 23:58:00 1.4 --- info.n 2000/07/22 01:22:20 *************** *** 110,119 **** .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. --- 110,120 ---- .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, and all statically-loaded ! packages initialized in \fIinterp\fR by \fBTcl_StaticPackage\fR. 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 provided when that file was loaded. 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. Index: doc/load.n =================================================================== RCS file: /cvsroot/tcl/doc/load.n,v retrieving revision 1.5 diff -c -r1.5 load.n *** load.n 2000/04/14 23:01:55 1.5 --- load.n 2000/07/22 01:22:20 *************** *** 61,72 **** .CS typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR); .CE ! The \fIinterp\fR argument identifies the interpreter in which the ! 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. .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 --- 61,76 ---- .CS typedef int Tcl_PackageInitProc(Tcl_Interp *\fIinterp\fR); .CE ! The \fIinterp\fR argument identifies the interpreter in which the 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, which will be returned as the result of \fBload\fR. ! If the initialization procedure completes successfully, it must provide ! the package \fIpackageName\fR. If it fails to do so, \fBload\fR will ! return an error message reporting that failure. If the initialization ! procedure successfully provides the package \fIpackageName\fR in ! \fIinterp\fR, \fBload\fR returns an empty string. .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 *************** *** 88,98 **** 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 .PP If \fIfileName\fR is an empty string, then \fIpackageName\fR must --- 92,105 ---- 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 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. .VE ! 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. .VS "" br .PP If \fIfileName\fR is an empty string, then \fIpackageName\fR must Index: generic/tclLoad.c =================================================================== RCS file: /cvsroot/tcl/generic/tclLoad.c,v retrieving revision 1.4 diff -c -r1.4 tclLoad.c *** tclLoad.c 1999/12/01 00:08:28 1.4 --- tclLoad.c 2000/07/22 01:22:21 *************** *** 27,35 **** * 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". * Malloc-ed. */ ClientData clientData; /* Token for the loaded file which should be * passed to TclpUnloadFile() when the file --- 27,33 ---- * package was loaded. An empty string * means the package is loaded statically. * Malloc-ed. */ ! char *packageName; /* Name of package. * Malloc-ed. */ ClientData clientData; /* Token for the loaded file which should be * passed to TclpUnloadFile() when the file *************** *** 68,74 **** * 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 * interpreter that points to the first package (if any). */ --- 66,72 ---- * 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 "tclLoad") for the * interpreter that points to the first package (if any). */ *************** *** 161,167 **** slaveIntName = Tcl_GetString(objv[3]); target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { ! return TCL_ERROR; } } --- 159,166 ---- slaveIntName = Tcl_GetString(objv[3]); target = Tcl_GetSlave(interp, slaveIntName); if (target == NULL) { ! code = TCL_ERROR; ! goto done; } } *************** *** 171,178 **** * it meets any of the following conditions: * - Its name and file match the once 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. */ Tcl_MutexLock(&packageMutex); --- 170,181 ---- * it meets any of the following conditions: * - Its name and file match the once 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 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,192 **** 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; --- 188,193 ---- *************** *** 300,325 **** } Tcl_DStringAppend(&pkgName, pkgGuess, (p - pkgGuess)); ckfree((char *)pargv); } } - /* - * 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. */ Tcl_DStringAppend(&initName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&initName, "_Init", 5); - Tcl_DStringAppend(&safeInitName, Tcl_DStringValue(&pkgName), -1); Tcl_DStringAppend(&safeInitName, "_SafeInit", 9); /* --- 301,331 ---- } 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))); } } /* ! * 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, "_SafeInit", 9); /* *************** *** 373,381 **** if (pkgPtr->safeInitProc != NULL) { code = (*pkgPtr->safeInitProc)(target); } else { Tcl_AppendResult(interp, "can't use package in a safe interpreter: ", ! "no ", pkgPtr->packageName, "_SafeInit procedure", (char *) NULL); code = TCL_ERROR; goto done; --- 379,391 ---- 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 ", Tcl_DStringValue(&tmp), "_SafeInit procedure", (char *) NULL); code = TCL_ERROR; goto done; *************** *** 385,411 **** } /* ! * Record the fact that the package has been loaded in the ! * target interpreter. */ - - 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 { TclTransferResult(target, code, interp); } done: Tcl_DStringFree(&pkgName); Tcl_DStringFree(&initName); --- 395,447 ---- } /* ! * If the initialization procedure failed, return the error ! * message, and don't register the load in the target interp. */ ! 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, we want to report that as an + * error to the caller, and we want to 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); + } + Tcl_AppendResult(interp, "loading \"", fullFileName, + "\" did not provide package \"", pkgPtr->packageName, "\"", + (char *) NULL); + if (target != interp) { + Tcl_AppendResult(interp, " in ", Tcl_GetString(objv[3]), + (char *) NULL); + } + code = TCL_ERROR; + 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,447 **** * 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). */ Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate * this package into a trusted * interpreter. */ --- 475,481 ---- * package has already been loaded * into the given interpreter by * calling the appropriate init proc. */ ! char *pkgName; /* Name of package */ Tcl_PackageInitProc *initProc; /* Procedure to call to incorporate * this package into a trusted * interpreter. */ *************** *** 454,459 **** --- 488,505 ---- { 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/generic/tclTest.c,v retrieving revision 1.18 diff -c -r1.18 tclTest.c *** tclTest.c 2000/05/19 21:30:16 1.18 --- tclTest.c 2000/07/22 01:22:23 *************** *** 49,54 **** --- 49,61 ---- 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". */ *************** *** 3035,3040 **** --- 3042,3052 ---- 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; *************** *** 3045,3050 **** --- 3057,3063 ---- 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/tests/load.test,v retrieving revision 1.7 diff -c -r1.7 load.test *** load.test 2000/04/10 17:19:01 1.7 --- load.test 2000/07/22 01:22:24 *************** *** 66,74 **** 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} \ [list $dll $loaded] { ! 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"}} --- 66,74 ---- 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 explicit package name} \ [list $dll $loaded] { ! 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,130 **** "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 } {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-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 set result [info loaded x] interp delete x set result } "{[file join $testDir pkga$ext] Pkga}" # On some platforms, like SunOS 4.1.3, these tests can't be run because # they cause the process to exit. --- 109,143 ---- "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 } {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 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. *************** *** 133,138 **** --- 146,158 ---- 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 + } "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] { set x "not loaded" *************** *** 152,170 **** test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] { set x "not loaded" teststaticpkg More 0 1 load {} More ! set x ! } {not loaded} test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ [list $dll $loaded] { 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" 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" test load-8.2 {TclGetLoadedPackages procedure} [list $dll $loaded] { list [catch {info loaded gorp} msg] $msg } {1 {could not find interpreter "gorp"}} --- 172,192 ---- test load-7.3 {Tcl_StaticPackage procedure} [list $dll $loaded] { set x "not loaded" teststaticpkg More 0 1 + set result $x + set x "not loaded" load {} More ! list $result $x ! } {loaded {not loaded}} test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \ [list $dll $loaded] { teststaticpkg Double 0 1 teststaticpkg Double 0 1 ! 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 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,178 **** 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 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 --- 194,200 ---- 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 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/unix/dltest/pkgd.c,v retrieving revision 1.4 diff -c -r1.4 pkgd.c *** pkgd.c 2000/04/04 08:06:07 1.4 --- pkgd.c 2000/07/22 01:22:25 *************** *** 117,126 **** --- 117,131 ---- 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,164 **** --- 160,174 ---- 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;