Tcl Source Code

Check-in [8ceea4a885]
Login

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

Overview
Comment:Restrict the stub library to only use Tcl_PkgRequireEx, Tcl_ResetResult and Tcl_AppendResult, not any other function. This puts least restrictions on eventual Tcl 9 stubs re-organization, and it works on the widest range of Tcl versions.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 8ceea4a8857d1368ed8cc07aedf7f3d05c20ccff
User & Date: jan.nijtmans 2013-01-07 14:40:56
Context
2017-06-08
21:00
Check in reference implementation of TIP 452.

TO DO: create test for two existing Tcl procedure. O... Closed-Leaf check-in: b56766d58c user: gerald tags: mistake

2013-01-08
08:08
mSys doesn't have $PWD. Reported by Rene Zaumseil on Tcl Core list check-in: 0d1bc53480 user: jan.nijtmans tags: trunk
03:32
merge trunk check-in: 9904da079b user: mig tags: mig-alloc-reform
01:26
merge trunk check-in: bc7170d76c user: mig tags: mig-no280
2013-01-07
18:38
backout, and merge trunk check-in: 31794a3cc2 user: mig tags: mig-nre-mods
14:40
Restrict the stub library to only use Tcl_PkgRequireEx, Tcl_ResetResult and Tcl_AppendResult, not an... check-in: 8ceea4a885 user: jan.nijtmans tags: trunk
13:00
merge-mark. Hoping trunk is OK now, again ;-( check-in: 212c2767fe user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.









1
2
3
4
5
6
7








2013-01-06  Jan Nijtmans  <[email protected]>

	* library/http/http.tcl: Don't depend on Spencer-specific regexp
	* tests/env.test: syntax (/u and /U) any more in unrelated places.
	* tests/exec.test:
	Bump http package to 2.8.6.

>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2013-01-07  Jan Nijtmans  <[email protected]>

	* generic/tclOOStubLib.c: Restrict the stub library to only use
	* generic/tclTomMathStubLib.c: Tcl_PkgRequireEx, Tcl_ResetResult
	and Tcl_AppendResult, not any other function. This puts least
	restrictions on eventual Tcl 9 stubs re-organization, and it
	works on the widest range of Tcl versions.

2013-01-06  Jan Nijtmans  <[email protected]>

	* library/http/http.tcl: Don't depend on Spencer-specific regexp
	* tests/env.test: syntax (/u and /U) any more in unrelated places.
	* tests/exec.test:
	Bump http package to 2.8.6.

Changes to generic/tclOOStubLib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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
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







/*
 * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
 */

/*
 * We need to ensure that we use the tcl stub macros so that this file
 * contains no references to any of the tcl stub functions.
 */

#undef USE_TCL_STUBS
#define USE_TCL_STUBS

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

#define USE_TCLOO_STUBS 1
#include "tclOOInt.h"

MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;

const TclOOStubs *tclOOStubsPtr = NULL;
const TclOOIntStubs *tclOOIntStubsPtr = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclOOInitializeStubs --
 *	Load the tclOO package, initialize stub table pointer. Do not call
 *	this function directly, use Tcl_OOInitStubs() macro instead.
 *
 * Results:
 *	The actual version of the package that satisfies the request, or NULL
 *	to indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointer.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp, const char *version)

{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *errMsg = NULL;
    ClientData clientData = NULL;
    const char *actualVersion =
	    Tcl_PkgRequireEx(interp, packageName,version, exact, &clientData);

    if (clientData == NULL) {
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"error loading %s package; package not present or incomplete",
		packageName));
	return NULL;
    } else {
	const TclOOStubs * const stubsPtr = clientData;
	const TclOOIntStubs * const intStubsPtr = stubsPtr->hooks ?
		stubsPtr->hooks->tclOOIntStubs : NULL;

	if (!actualVersion) {
	    return NULL;
	}

	if (!stubsPtr || !intStubsPtr) {
	    errMsg = "missing stub table pointer";
	    goto error;
	}

	tclOOStubsPtr = stubsPtr;



	tclOOIntStubsPtr = intStubsPtr;

	return actualVersion;

    error:
	Tcl_ResetResult(interp);
	Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error loading %s package"
		" (requested version '%s', loaded version '%s'): %s",
		packageName, version, actualVersion, errMsg));
	return NULL;
    }
}











<
<
<
<
<
<
<
<
<
<
<
<
<




















|






|
>




|
|
<
<
<
<
<
<
|
<
<
<
<
<

|
|
|
|
<
|
<
<
|

>
>
>
|
>

|
<
|
|
|
|
|
|
|
>
>
>
>
>
>
>
1
2
3
4













5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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
50
51
52
53
54
55

56
57
58
59
60
61
62
63
64
65
66
67
68
69
/*
 * ORIGINAL SOURCE: tk/generic/tkStubLib.c, version 1.9 2004/03/17
 */














#include "tclOOInt.h"

MODULE_SCOPE const TclOOStubs *tclOOStubsPtr;
MODULE_SCOPE const TclOOIntStubs *tclOOIntStubsPtr;

const TclOOStubs *tclOOStubsPtr = NULL;
const TclOOIntStubs *tclOOIntStubsPtr = NULL;

/*
 *----------------------------------------------------------------------
 *
 * TclOOInitializeStubs --
 *	Load the tclOO package, initialize stub table pointer. Do not call
 *	this function directly, use Tcl_OOInitStubs() macro instead.
 *
 * Results:
 *	The actual version of the package that satisfies the request, or NULL
 *	to indicate that an error occurred.
 *
 * Side effects:
 *	Sets the stub table pointers.
 *
 *----------------------------------------------------------------------
 */

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp,
    const char *version)
{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *errMsg = NULL;
    TclOOStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,






	    packageName, version, exact, &stubsPtr);






    if (actualVersion == NULL) {
	return NULL;
    }
    if (stubsPtr == NULL) {

	errMsg = "missing stub table pointer";


    } else {
	tclOOStubsPtr = stubsPtr;
	if (stubsPtr->hooks) {
	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;
	} else {
	    tclOOIntStubsPtr = NULL;
	}
	return actualVersion;
    }

    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
	    " (requested version ", version, ", actual version ",
	    actualVersion, "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclTomMathStubLib.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
/*
 * tclTomMathStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

/*
 * We need to ensure that we use the stub macros so that this file contains no
 * references to any of the stub functions. This will make it possible to
 * build an extension that references Tcl_InitStubs but doesn't end up
 * including the rest of the stub functions.
 */

#define USE_TCL_STUBS

#include "tclInt.h"

MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;

const TclTomMathStubs *tclTomMathStubsPtr = NULL;















<
<
<
<
<
<
<
<
<







1
2
3
4
5
6
7
8
9
10
11
12
13









14
15
16
17
18
19
20
/*
 * tclTomMathStubLib.c --
 *
 *	Stub object that will be statically linked into extensions that want
 *	to access Tcl.
 *
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 * Copyright (c) 1998 Paul Duffin.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */










#include "tclInt.h"

MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr;

const TclTomMathStubs *tclTomMathStubsPtr = NULL;


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
86
87
88
89
    int epoch,			/* Stubs table epoch from the header files */
    int revision)		/* Stubs table revision number from the
				 * header files */
{
    int exact = 0;
    const char *packageName = "tcl::tommath";
    const char *errMsg = NULL;
    ClientData pkgClientData = NULL;
    const char *actualVersion =
	Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
    const TclTomMathStubs *stubsPtr = pkgClientData;

    if (actualVersion == NULL) {
	return NULL;
    }
    if (pkgClientData == NULL) {
	errMsg = "missing stub table pointer";
    } else if ((stubsPtr->tclBN_epoch)() != epoch) {
	errMsg = "epoch number mismatch";
    } else if ((stubsPtr->tclBN_revision)() != revision) {
	errMsg = "requires a later revision";
    } else {
	tclTomMathStubsPtr = stubsPtr;
	return actualVersion;
    }

    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "error loading %s (requested version %s, actual version %s): %s",
	    packageName, version, actualVersion, errMsg));
    return NULL;
}

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







|
|
|
<




|

|

|





|
|
|
|


|







42
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
    int epoch,			/* Stubs table epoch from the header files */
    int revision)		/* Stubs table revision number from the
				 * header files */
{
    int exact = 0;
    const char *packageName = "tcl::tommath";
    const char *errMsg = NULL;
    TclTomMathStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, exact, &stubsPtr);


    if (actualVersion == NULL) {
	return NULL;
    }
    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";
    } else if(stubsPtr->tclBN_epoch() != epoch) {
	errMsg = "epoch number mismatch";
    } else if(stubsPtr->tclBN_revision() != revision) {
	errMsg = "requires a later revision";
    } else {
	tclTomMathStubsPtr = stubsPtr;
	return actualVersion;
    }
    tclStubsPtr->tcl_ResetResult(interp);
    tclStubsPtr->tcl_AppendResult(interp, "Error loading ", packageName,
	    " (requested version ", version, ", actual version ",
	    actualVersion, "): ", errMsg, NULL);
    return NULL;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */