Tcl Source Code

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

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

 * 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;








<








48
49
50
51
52
53
54

55
56
57
58
59
60
61

 * 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;
︙︙
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577

    }
    /* 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);








<
<
<
<








559
560
561
562
563
564
565




566
567
568
569
570
571
572

    }
    /* 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);
︙︙
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

    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








<
<
<
<
<
<
<
<
<
<
<








785
786
787
788
789
790
791











792
793
794
795
796
797
798

    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

	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








<
<
<
<
<
<
<
<
<








170
171
172
173
174
175
176









177
178
179
180
181
182
183

	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
︙︙
1161
1162
1163
1164
1165
1166
1167








1168
1169
1170
1171
1172
1173
1174

    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);









>
>
>
>
>
>
>
>








1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173

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

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