Tcl Source Code

Check-in [df825488e6]
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:Use a thread exit handler, and not a custom exit proc for package cleanup.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: df825488e649e15bb2bbf105bef86df54196e8d306a29dba504bd11a712fe214
User & Date: dgp 2018-06-26 17:00:29
Context
2018-07-05
19:39
tclDictObj.c:366: warning: dereferencing type-punned pointer will break strict-aliasing rules Preven... check-in: c655de97b1 user: jan.nijtmans tags: core-8-6-branch
2018-06-26
17:07
merge 8.6 check-in: a421b7549a user: dgp tags: core-8-branch
17:00
Use a thread exit handler, and not a custom exit proc for package cleanup. check-in: df825488e6 user: dgp tags: core-8-6-branch
14:22
Restore lost tests. check-in: 2fbb67bc78 user: dgp tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclInt.h.

4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
 */

MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
MODULE_SCOPE void TclThreadTestFinalize();

/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);






<







4528
4529
4530
4531
4532
4533
4534

4535
4536
4537
4538
4539
4540
4541
 */

MODULE_SCOPE Tcl_PackageInitProc TclplatformtestInit;
MODULE_SCOPE Tcl_PackageInitProc TclObjTest_Init;
MODULE_SCOPE Tcl_PackageInitProc TclThread_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_Init;
MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;


/*
 *----------------------------------------------------------------
 * Macro used by the Tcl core to check whether a pattern has any characters
 * special to [string match]. The ANSI C "prototype" for this macro is:
 *
 * MODULE_SCOPE int	TclMatchIsTrivial(const char *pattern);

Changes to generic/tclTest.c.

48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
...
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
EXTERN int		Tcltest_Init(Tcl_Interp *interp);
EXTERN int		Tcltest_SafeInit(Tcl_Interp *interp);
EXTERN TCL_NORETURN void	Tcltest_Exit(ClientData clientData);

/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
................................................................................
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
	return TCL_ERROR;
    }


    /* Finalizer */
    Tcl_SetExitProc(Tcltest_Exit);

    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
................................................................................
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
}
 
TCL_NORETURN void Tcltest_Exit(
    ClientData clientData
) {
    int status = PTR2INT(clientData);
    Tcl_Finalize();
    TclThreadTestFinalize();
    TclpExit(status);
    Tcl_Panic("OS exit failed!");
}
	
 
/*
 *----------------------------------------------------------------------
 *
 * TestasyncCmd --
 *
 *	This procedure implements the "testasync" command.  It is used






<







 







<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<







48
49
50
51
52
53
54

55
56
57
58
59
60
61
...
559
560
561
562
563
564
565




566
567
568
569
570
571
572
...
785
786
787
788
789
790
791











792
793
794
795
796
797
798
 * accessed when we are building a library.
 */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT
EXTERN int		Tcltest_Init(Tcl_Interp *interp);
EXTERN int		Tcltest_SafeInit(Tcl_Interp *interp);


/*
 * Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
 * the results of the various deletion callbacks.
 */

static Tcl_DString delString;
................................................................................
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
	return TCL_ERROR;
    }





    /*
     * Create additional commands and math functions for testing Tcl.
     */

    Tcl_CreateObjCommand(interp, "gettimes", GetTimesObjCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "noop", NoopCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
................................................................................
    Tcl_Interp *interp)		/* Interpreter for application. */
{
    if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
	return TCL_ERROR;
    }
    return Procbodytest_SafeInit(interp);
}











 
/*
 *----------------------------------------------------------------------
 *
 * TestasyncCmd --
 *
 *	This procedure implements the "testasync" command.  It is used

Changes to generic/tclThreadTest.c.

170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
....
1161
1162
1163
1164
1165
1166
1167








1168
1169
1170
1171
1172
1173
1174
	mainThreadId = Tcl_GetCurrentThread();
    }
    Tcl_MutexUnlock(&threadMutex);

    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
    return TCL_OK;
}

 
void TclThreadTestFinalize() {
    if (errorProcString != NULL) {
	ckfree(errorProcString);
	errorProcString= NULL;
    }
    return;
}
 
/*
 *----------------------------------------------------------------------
 *
 * ThreadObjCmd --
 *
 *	This procedure is invoked to process the "testthread" Tcl command. See
................................................................................
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->interp != NULL) {
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);









    if (threadEvalScript) {
	ckfree(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);







<
<
<
<
<
<
<
<
<







 







>
>
>
>
>
>
>
>







170
171
172
173
174
175
176









177
178
179
180
181
182
183
....
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
	mainThreadId = Tcl_GetCurrentThread();
    }
    Tcl_MutexUnlock(&threadMutex);

    Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
    return TCL_OK;
}









 
/*
 *----------------------------------------------------------------------
 *
 * ThreadObjCmd --
 *
 *	This procedure is invoked to process the "testthread" Tcl command. See
................................................................................
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->interp != NULL) {
	ListRemove(tsdPtr);
    }

    Tcl_MutexLock(&threadMutex);

    if (self == errorThreadId) {
	if (errorProcString) {	/* Extra safety */
	    ckfree(errorProcString);
	    errorProcString = NULL;
	}
	errorThreadId = 0;
    }

    if (threadEvalScript) {
	ckfree(threadEvalScript);
	threadEvalScript = NULL;
    }
    Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);