Tcl Source Code

Check-in [7bc615df40]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:syntax improvement: expect options before the filename

start at documentation

Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | frq-3579001
Files: files | file ages | folders
SHA1: 7bc615df40c062b02f090a6708f8b881074b05dc
User & Date: jan.nijtmans 2012-10-24 21:22:30
Context
2012-11-06
21:16
merge trunk check-in: 892cbafd88 user: dkf tags: frq-3579001
2012-10-24
21:22
syntax improvement: expect options before the filename

start at documentation

check-in: 7bc615df40 user: jan.nijtmans tags: frq-3579001
13:08
experimental implementation of FRQ-3579001 check-in: 0895bccd51 user: jan.nijtmans tags: frq-3579001
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/Load.3.

27
28
29
30
31
32
33
34

35
36
37
38
39
40
41
The name of the file to load. If it is a single name, the library search path
of the current environment will be used to resolve it.
.AP "const char *const" symbols[] in
Array of names of symbols to be resolved during the load of the library, or
NULL if no symbols are to be resolved. If an array is given, the last entry in
the array must be NULL.
.AP int flags in
Reserved for future expansion. Must be 0.

.AP void *procPtrs out
Points to an array that will hold the addresses of the functions described in
the \fIsymbols\fR argument. Should be NULL if no symbols are to be resolved.
.AP Tcl_LoadHandle *loadHandlePtr out
Points to a variable that will hold the handle to the abstract token
describing the library that has been loaded.
.AP Tcl_LoadHandle loadHandle in






|
>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
The name of the file to load. If it is a single name, the library search path
of the current environment will be used to resolve it.
.AP "const char *const" symbols[] in
Array of names of symbols to be resolved during the load of the library, or
NULL if no symbols are to be resolved. If an array is given, the last entry in
the array must be NULL.
.AP int flags in
The value should normally be 0, but \fITCL_LOAD_GLOBALfR or \fITCL_LOAD_LAZYfR
or a combination of those two is allowed as well.
.AP void *procPtrs out
Points to an array that will hold the addresses of the functions described in
the \fIsymbols\fR argument. Should be NULL if no symbols are to be resolved.
.AP Tcl_LoadHandle *loadHandlePtr out
Points to a variable that will hold the handle to the abstract token
describing the library that has been loaded.
.AP Tcl_LoadHandle loadHandle in

Changes to doc/load.n.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
100
101
102
103
104
105
106









107
108
109
110
111
112
113
.so man.macros
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
load \- Load machine code and initialize new commands
.SH SYNOPSIS
\fBload \fIfileName\fR
.br
\fBload \fIfileName packageName\fR
.br
\fBload \fIfileName packageName interp\fR
.BE
.SH DESCRIPTION
.PP
This command loads binary code from a file into the
application's address space and calls an initialization procedure
in the package to incorporate it into an interpreter.  \fIfileName\fR
is the name of the file containing the code;  its exact form varies
................................................................................
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
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.









.SH "PORTABILITY ISSUES"
.TP
\fBWindows\fR\0\0\0\0\0
.
When a load fails with
.QW "library not found"
error, it is also possible






|

|

|







 







>
>
>
>
>
>
>
>
>







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
...
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
.so man.macros
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
load \- Load machine code and initialize new commands
.SH SYNOPSIS
\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
.br
\fBload ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
.br
\fBload ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
.BE
.SH DESCRIPTION
.PP
This command loads binary code from a file into the
application's address space and calls an initialization procedure
in the package to incorporate it into an interpreter.  \fIfileName\fR
is the name of the file containing the code;  its exact form varies
................................................................................
The \fBload\fR command first searches for a statically loaded package
(one that has been registered by calling the \fBTcl_StaticPackage\fR
procedure) by that name; if one is found, it is used.
Otherwise, the \fBload\fR command searches for a dynamically loaded
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.
.PP
If \fB\-global\fR is specified preceding the filename, all symbols
found in the shared library are exported for global use by other
libraries. The option \fB\-lazy\fR delays the actual loading of
symbols until their first actual use. The options may be abbreviated.
The option \fB\-\-\fR indicates the end of the options, and should
be used if you wish to use a filename which starts with \fB\-\fR.
On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
options, the options still exist but have no effect.
.SH "PORTABILITY ISSUES"
.TP
\fBWindows\fR\0\0\0\0\0
.
When a load fails with
.QW "library not found"
error, it is also possible

Changes to generic/tclLoad.c.

131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157

158

159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
...
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
...
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
...
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch;
    unsigned len;
    int index, flags = 0;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const options[] = {
	"-global",		"-lazy",	NULL
    };
    enum options {
	LOAD_GLOBAL,	LOAD_LAZY
    };

    while (objc > 2) {
	if (TclGetString(objv[2])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[2], options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	switch ((enum options) index) {
	case LOAD_GLOBAL:
	    flags |= 1;
	    break;
	case LOAD_LAZY:

	    flags |= 2;

	    break;
	}
    }
    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "fileName ?-global? ?-lazy? ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, savedobjv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    fullFileName = Tcl_GetString(savedobjv[1]);

    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&unloadName);
    Tcl_DStringInit(&safeUnloadName);
    Tcl_DStringInit(&tmp);
................................................................................
		 * The platform-specific code couldn't figure out the module
		 * name. Make a guess by taking the last element of the file
		 * name, stripping off any leading "lib", and then using all
		 * of the alphabetic and underline characters that follow
		 * that.
		 */

		splitPtr = Tcl_FSSplitPath(savedobjv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = Tcl_GetString(pkgGuessPtr);
		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
			&& (pkgGuess[2] == 'b')) {
		    pkgGuess += 3;
		}
#ifdef __CYGWIN__
................................................................................
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, savedobjv[1], symbols, flags, &initProc,
		&loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
................................................................................
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *) 
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeUnloadName));
	pkgPtr->interpRefCount	   = 0;
	pkgPtr->safeInterpRefCount = 0;

	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		   = firstPackagePtr;






|


|



|


|




|
<

<
<
>

>
|



|


|


|







 







|







 







|







 







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153

154


155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
...
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
...
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
    const char *p, *fullFileName, *packageName;
    Tcl_LoadHandle loadHandle;
    Tcl_UniChar ch;
    unsigned len;
    int index, flags = 0;
    Tcl_Obj *const *savedobjv = objv;
    static const char *const options[] = {
	"-global",		"-lazy",		"--",	NULL
    };
    enum options {
	LOAD_GLOBAL,	LOAD_LAZY,	LOAD_LAST
    };

    while (objc > 2) {
	if (TclGetString(objv[1])[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[1], options, "option", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	++objv; --objc;
	if (LOAD_GLOBAL == (enum options) index) {

	    flags |= 1;


	} else if (LOAD_LAZY == (enum options) index) {
	    flags |= 2;
	} else {
		break;
	}
    }
    if ((objc < 2) || (objc > 4)) {
	Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?packageName? ?interp?");
	return TCL_ERROR;
    }
    if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) {
	return TCL_ERROR;
    }
    fullFileName = Tcl_GetString(objv[1]);

    Tcl_DStringInit(&pkgName);
    Tcl_DStringInit(&initName);
    Tcl_DStringInit(&safeInitName);
    Tcl_DStringInit(&unloadName);
    Tcl_DStringInit(&safeUnloadName);
    Tcl_DStringInit(&tmp);
................................................................................
		 * The platform-specific code couldn't figure out the module
		 * name. Make a guess by taking the last element of the file
		 * name, stripping off any leading "lib", and then using all
		 * of the alphabetic and underline characters that follow
		 * that.
		 */

		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = Tcl_GetString(pkgGuessPtr);
		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
			&& (pkgGuess[2] == 'b')) {
		    pkgGuess += 3;
		}
#ifdef __CYGWIN__
................................................................................
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);
	symbols[1] = NULL;

	Tcl_MutexLock(&packageMutex);
	code = Tcl_LoadFile(interp, objv[1], symbols, flags, &initProc,
		&loadHandle);
	Tcl_MutexUnlock(&packageMutex);
	if (code != TCL_OK) {
	    goto done;
	}

	/*
................................................................................
	pkgPtr->initProc	   = initProc;
	pkgPtr->safeInitProc	   = (Tcl_PackageInitProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeInitName));
	pkgPtr->unloadProc	   = (Tcl_PackageUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&unloadName));
	pkgPtr->safeUnloadProc	   = (Tcl_PackageUnloadProc *)
		Tcl_FindSymbol(interp, loadHandle,
			Tcl_DStringValue(&safeUnloadName));
	pkgPtr->interpRefCount	   = 0;
	pkgPtr->safeInterpRefCount = 0;

	Tcl_MutexLock(&packageMutex);
	pkgPtr->nextPtr		   = firstPackagePtr;

Changes to tests/load.test.

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]
 
test load-1.1 {basic errors} {} {
    list [catch {load} msg] $msg
} "1 {wrong \# args: should be \"load fileName ?-global? ?-lazy? ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
    list [catch {load a b c d} msg] $msg
} "1 {wrong \# args: should be \"load fileName ?-global? ?-lazy? ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
    list [catch {load {} -global} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load {} -lazy {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load foo -abc} msg] $msg
} "1 {bad option \"-abc\": must be -global or -lazy}"

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load [file join $testDir pkga$ext] -global
    list [pkga_eq abc def] [lsort [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] -lazy 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"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
................................................................................
    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
} [list 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] -global pkga
    load {} pkga x
    set result [info loaded x]
    interp delete x
    set result
} [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because






|


|




|


|





|
|



|





|







 







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest

testConstraint testsimplefilesystem \
	[llength [info commands testsimplefilesystem]]
 
test load-1.1 {basic errors} {} {
    list [catch {load} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.2 {basic errors} {} {
    list [catch {load a b c d} msg] $msg
} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
test load-1.3 {basic errors} {} {
    list [catch {load a b foobar} msg] $msg
} {1 {could not find interpreter "foobar"}}
test load-1.4 {basic errors} {} {
    list [catch {load -global {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.5 {basic errors} {} {
    list [catch {load -lazy {} {}} msg] $msg
} {1 {must specify either file name or package name}}
test load-1.6 {basic errors} {} {
    list [catch {load {} Unknown} msg] $msg
} {1 {package "Unknown" isn't loaded statically}}
test load-1.7 {basic errors} {} {
    list [catch {load -abc foo} msg] $msg
} "1 {bad option \"-abc\": must be -global, -lazy, or --}"

test load-2.1 {basic loading, with guess for package name} \
	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [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 -lazy [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"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
................................................................................
    list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
} [list 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 -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    set result [info loaded x]
    interp delete x
    set result
} [list [list [file join $testDir pkga$ext] Pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because

Changes to unix/tclLoadDl.c.

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    Tcl_Interp *interp,		/* Place to put error messages. */
    Tcl_LoadHandle loadHandle,	/* Value from TcpDlopen(). */
    const char *symbol)		/* Symbol to look up. */
{
    const char *native;		/* Name of the library to be loaded, in
				 * system encoding */
    Tcl_DString newName, ds;	/* Buffers for converting the name to
				 * system encoding and prepending an 
				 * underscore*/
    void *handle = (void *) loadHandle->clientData;
				/* Native handle to the loaded library */
    void *proc;			/* Address corresponding to the resolved
				 * symbol */

    /*






|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    Tcl_Interp *interp,		/* Place to put error messages. */
    Tcl_LoadHandle loadHandle,	/* Value from TcpDlopen(). */
    const char *symbol)		/* Symbol to look up. */
{
    const char *native;		/* Name of the library to be loaded, in
				 * system encoding */
    Tcl_DString newName, ds;	/* Buffers for converting the name to
				 * system encoding and prepending an
				 * underscore*/
    void *handle = (void *) loadHandle->clientData;
				/* Native handle to the loaded library */
    void *proc;			/* Address corresponding to the resolved
				 * symbol */

    /*

Changes to unix/tclLoadNext.c.

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    Tcl_PackageInitProc *proc = NULL;
 
   if (symbol) {
	char sym[strlen(symbol) + 2];

	sym[0] = '_';
	sym[1] = 0;
	strcat(sym, symbol);
	rld_lookup(NULL, sym, (unsigned long *) &proc);






|







130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    Tcl_PackageInitProc *proc = NULL;

   if (symbol) {
	char sym[strlen(symbol) + 2];

	sym[0] = '_';
	sym[1] = 0;
	strcat(sym, symbol);
	rld_lookup(NULL, sym, (unsigned long *) &proc);