Tcl Source Code

Check-in [6f650b4271]
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:Add custom exit procedure for tcltests executable.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | pyk-tcltest-exit
Files: files | file ages | folders
SHA3-256: 6f650b4271a1ef2e0bdf410a47c5daed1130c71635662340d5b5654997f91a47
User & Date: pooryorick 2018-06-21 22:21:31
Context
2018-06-21
22:43
Fix function signature of TclThreadTestFinalize. Leaf check-in: b8061e5833 user: pooryorick tags: pyk-tcltest-exit
22:23
merge pyk-tcltest-exit check-in: 09af8379c8 user: pooryorick tags: core-8-6-branch
22:21
Add custom exit procedure for tcltests executable. check-in: 6f650b4271 user: pooryorick tags: pyk-tcltest-exit
22:16
Suppress more valgrind "still reachable" reports and ensure that threads are fully finalized in thre... check-in: 494d51f962 user: pooryorick 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
 */

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






>







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

Changes to generic/tclTest.c.

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






>







 







>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>







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

Changes to generic/tclThreadTest.c.

171
172
173
174
175
176
177







178
179
180
181
182
183
184
    }
    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






>
>
>
>
>
>
>







171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
    }
    Tcl_MutexUnlock(&threadMutex);

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

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