Tcl Source Code

Check-in [6b6ef4e0b1]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:Add some (temporary) test cases showing the problem with --export-dynamic
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 6b6ef4e0b11f482e8727ae13f5d62f8b916badb4
User & Date: jan.nijtmans 2011-04-07 10:19:46
Context
2011-04-08
06:31
fix for [Bug 3280043]: win2k: unresolved DLL imports check-in: d43bba3681 user: jan.nijtmans tags: trunk
2011-04-07
10:24
merge latest trunk check-in: 953246bca5 user: jan.nijtmans tags: jn-frq-3257396
10:19
Add some (temporary) test cases showing the problem with --export-dynamic check-in: 6b6ef4e0b1 user: jan.nijtmans tags: trunk
02:56
* generic/tclExecute.c (TclCompileObj): earlier return if Tip280 gymnastics not needed. check-in: 63b453f584 user: mig tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/load.test.

︙︙
78
79
80
81
82
83
84




85
86
87
88
89
90
91

    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}





test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing








>
>
>
>








78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \
    -result [list 1 {cannot find symbol "Foo_Init"*} \
		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
} {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
# This test fails due to --export-dynamic
test load-2.5 {loading package with symbol conflict, this test fails when using  --export-dynamic} [list $dll $loaded] {
    pkga_quote
} {I'm in pkga.c}

test load-3.1 {error in _Init procedure, same interpreter} \
	[list $dll $loaded] {
    list [catch {load [file join $testDir pkge$ext] pkge} msg] \
	    $msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
    while executing
︙︙

Changes to unix/dltest/pkga.c.

︙︙
25
26
27
28
29
30
31











32
33
34
35
36
37
38

 * Prototypes for procedures defined later in this file:
 */

static int    Pkga_EqObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int    Pkga_QuoteObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);












/*
 *----------------------------------------------------------------------
 *
 * Pkga_EqObjCmd --
 *
 *	This procedure is invoked to process the "pkga_eq" Tcl command. It








>
>
>
>
>
>
>
>
>
>
>








25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

 * Prototypes for procedures defined later in this file:
 */

static int    Pkga_EqObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int    Pkga_QuoteObjCmd(ClientData clientData,
		Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
/*
 * Function to be backlinked from the tcltest executable
 */
#if 0
extern const char *Tcltest_Foo();
#else
EXTERN const char *Tcltest_Foo() {
    return "I'm in pkga.c";
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * Pkga_EqObjCmd --
 *
 *	This procedure is invoked to process the "pkga_eq" Tcl command. It
︙︙
95
96
97
98
99
100
101
102
103
104
105



106

107
108
109
110
111
112
113

static int
Pkga_QuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }



    Tcl_SetObjResult(interp, objv[1]);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkga_Init --








|



>
>
>

>








106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

static int
Pkga_QuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    if (objc == 1) {
	Tcl_SetResult(interp, (char *) Tcltest_Foo(), TCL_VOLATILE);
    } else {
    Tcl_SetObjResult(interp, objv[1]);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkga_Init --
︙︙

Changes to unix/dltest/pkgua.c.

︙︙
9
10
11
12
13
14
15

16
17
18
19
20
21
22

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"


/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * Pkgua_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */
#undef TCL_STORAGE_CLASS








>








9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#undef STATIC_BUILD
#include "tcl.h"
#include <stdio.h>

/*
 * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
 * Pkgua_Init declaration is in the source file itself, which is only
 * accessed when we are building a library.
 */
#undef TCL_STORAGE_CLASS
︙︙
171
172
173
174
175
176
177
178
179
180
181









182

183
184
185
186
187
188
189

static int
PkguaQuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }









    Tcl_SetObjResult(interp, objv[1]);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgua_Init --








|



>
>
>
>
>
>
>
>
>

>








172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

static int
PkguaQuoteObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "value");
	return TCL_ERROR;
    }
    if (objc == 1) {
	int major, minor, patch, type;
	char result[128];

#undef Tcl_GetVersion /* Link this symbol without stubs */
	Tcl_GetVersion(&major, &minor, &patch, &type);
	sprintf(result, "%d %d %d %d", major, minor, patch, type);
	Tcl_SetResult(interp, result, TCL_VOLATILE);
    } else {
    Tcl_SetObjResult(interp, objv[1]);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Pkgua_Init --
︙︙

Changes to unix/tclAppInit.c.

︙︙
150
151
152
153
154
155
156








157
158
159
160
161
162
163

    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif

    return TCL_OK;
}









/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:








>
>
>
>
>
>
>
>








150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171

    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/tclsh.rc", TCL_GLOBAL_ONLY);
#else
    (Tcl_SetVar)(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY);
#endif

    return TCL_OK;
}

#ifdef TCL_TEST
#   undef TCL_STORAGE_CLASS
#   define TCL_STORAGE_CLASS DLLEXPORT
EXTERN const char *Tcltest_Foo() {
    return "I'm in tclAppInit.c";
}
#endif /* TCL_TEST */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
︙︙

This page was generated in about 0.02s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19