Tcl Source Code

Check-in [4355f3d4c8]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

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

Overview
Comment:Make pkgb.so loadable in Tcl 8.4 as well. Eliminate unnessarcy static HasStubSupport() and isDigit() functions, just do the same inline.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 4355f3d4c8461f0be579417753cd8e41d35b003a
User & Date: jan.nijtmans 2012-12-21 08:36:38
Context
2012-12-26
09:55
eliminate dependancy of compat/*.h on tcl.h check-in: 5e21e8284c user: jan.nijtmans tags: core-8-5-branch
2012-12-25
12:09
proposed fix for Bug 3598300 Closed-Leaf check-in: 02a51cbb69 user: jan.nijtmans tags: bug-3598300
2012-12-21
09:13
Inline compat Tcl_GetDefaultEncodingDir. Eliminate unnecessary static HasStubSupport() and isDigit(... check-in: fd98f3556d user: jan.nijtmans tags: trunk
08:36
Make pkgb.so loadable in Tcl 8.4 as well. Eliminate unnessarcy static HasStubSupport() and isDigit(... check-in: 4355f3d4c8 user: jan.nijtmans tags: core-8-5-branch
08:16
Turn pkgb.so into a Tcl9 interoperability test library: Whatever Tcl9 looks like, loading pkgb.so in... check-in: f3a3b2cd2a user: jan.nijtmans tags: core-8-4-branch
2012-12-13
16:16
Restore clarity to macro test. check-in: 66b3be3b10 user: dgp tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 







1
2
3
4
5
6
7







2012-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it
	doesn't access its objPtr parameter twice any more.

2012-12-07  Jan Nijtmans  <[email protected]>


>
>
>
>
>
>








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

2012-12-21  Jan Nijtmans  <[email protected]>

	* unix/dltest/pkgb.c:  Make pkgb.so loadable in Tcl 8.4 as well.
	* generic/tclStubLib.c: Eliminate unnessarcy static HasStubSupport() and
	isDigit() functions, just do the same inline.

2012-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: Fix Tcl_DecrRefCount macro such that it
	doesn't access its objPtr parameter twice any more.

2012-12-07  Jan Nijtmans  <[email protected]>
︙︙

Changes to generic/tclStubLib.c.

︙︙
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


TclStubs *tclStubsPtr = NULL;
TclPlatStubs *tclPlatStubsPtr = NULL;
TclIntStubs *tclIntStubsPtr = NULL;
TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclTomMathStubs* tclTomMathStubsPtr = NULL;

static TclStubs *
HasStubSupport(
    Tcl_Interp *interp)
{
    Interp *iPtr = (Interp *) interp;

    if (iPtr->stubTable && (iPtr->stubTable->magic == TCL_STUB_MAGIC)) {
	return iPtr->stubTable;
    }
    interp->result = "interpreter uses an incompatible stubs mechanism";
    interp->freeProc = TCL_STATIC;
    return NULL;
}

/*
 * Use our own isdigit to avoid linking to libc on windows
 */

static int isDigit(const int c)
{
    return (c >= '0' && c <= '9');
}


/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitStubs --
 *
 *	Tries to initialise the stub table pointers and ensures that the








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

|


<
<
<
<
>








15
16
17
18
19
20
21














22
23
24
25




26
27
28
29
30
31
32
33


TclStubs *tclStubsPtr = NULL;
TclPlatStubs *tclPlatStubsPtr = NULL;
TclIntStubs *tclIntStubsPtr = NULL;
TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
TclTomMathStubs* tclTomMathStubsPtr = NULL;















/*
 * Use our own ISDIGIT to avoid linking to libc on windows
 */





#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitStubs --
 *
 *	Tries to initialise the stub table pointers and ensures that the
︙︙
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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109

#undef Tcl_InitStubs
CONST char *
Tcl_InitStubs(
    Tcl_Interp *interp,
    CONST char *version,
    int exact)
{

    CONST char *actualVersion = NULL;
    ClientData pkgData = NULL;
    TclStubs *stubsPtr;

    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */

    stubsPtr = HasStubSupport(interp);
    if (!stubsPtr) {


	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
    if (exact) {
	CONST char *p = version;
	int count = 0;

	while (*p) {
	    count += !isDigit(*p++);
	}
	if (count == 1) {
	    CONST char *q = actualVersion;

	    p = version;
	    while (*p && (*p == *q)) {
		p++; q++;
	    }
	    if (*p || isDigit(*q)) {
		/* Construct error message */
		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {








>


|







<
|
>
>












|








|








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
86
87
88
89
90
91
92
93
94

#undef Tcl_InitStubs
CONST char *
Tcl_InitStubs(
    Tcl_Interp *interp,
    CONST char *version,
    int exact)
{
    Interp *iPtr = (Interp *) interp;
    CONST char *actualVersion = NULL;
    ClientData pkgData = NULL;
    TclStubs *stubsPtr = iPtr->stubTable;

    /*
     * We can't optimize this check by caching tclStubsPtr because that
     * prevents apps from being able to load/unload Tcl dynamically multiple
     * times. [Bug 615304]
     */


    if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
	iPtr->result = "interpreter uses an incompatible stubs mechanism";
	iPtr->freeProc = TCL_STATIC;
	return NULL;
    }

    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
    if (actualVersion == NULL) {
	return NULL;
    }
    if (exact) {
	CONST char *p = version;
	int count = 0;

	while (*p) {
	    count += !ISDIGIT(*p++);
	}
	if (count == 1) {
	    CONST char *q = actualVersion;

	    p = version;
	    while (*p && (*p == *q)) {
		p++; q++;
	    }
	    if (*p || ISDIGIT(*q)) {
		/* Construct error message */
		stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
		return NULL;
	    }
	} else {
	    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
	    if (actualVersion == NULL) {
︙︙

Changes to unix/dltest/pkgb.c.

︙︙
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114

115


116
117
118
119
120
121
122

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Pkgb_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {

	return TCL_ERROR;


    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);








|






|
>
|
>
>








100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

DLLEXPORT int
Pkgb_Init(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd,
	    (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
︙︙
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

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Pkgb_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-9.1", 0) == NULL) {

	return TCL_ERROR;


    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}








|






|
>
|
>
>










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

 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

DLLEXPORT int
Pkgb_SafeInit(
    Tcl_Interp *interp)		/* Interpreter in which the package is to be
				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.4", 0) == NULL) {
	if (Tcl_InitStubs(interp, "8.4-", 0) == NULL) {
	    return TCL_ERROR;
	}
	Tcl_ResetResult(interp);
    }
    code = Tcl_PkgProvideEx(interp, "Pkgb", "2.3", NULL);
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, (ClientData) 0,
	    (Tcl_CmdDeleteProc *) NULL);
    return TCL_OK;
}

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