Tcl Source Code

Check-in [e9c99bce1d]
Login

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

Overview
Comment:merge pyk-tcltests
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: e9c99bce1dd199b34a881b3cadf5f7ec433f16e829fbb4abd56eed096c239d2a
User & Date: pooryorick 2021-04-26 22:52:22.959
Context
2021-04-26
22:53
Add io-28.6 an io-28.7 to test closing a channel within a channel event handler. check-in: f44cac056f user: pooryorick tags: core-8-branch
22:52
merge pyk-tcltests check-in: e9c99bce1d user: pooryorick tags: core-8-branch
22:48
Add test constaints "debug", "purify", and "debugpurify" check-in: aea1dc765b user: pooryorick tags: pyk-tcltests
2021-04-25
20:22
Document our reference count management check-in: 0bfb180cb0 user: dkf tags: core-8-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclTest.c.
223
224
225
226
227
228
229

230
231
232
233
234
235
236
static Tcl_CmdProc	TestcmdtokenCmd;
static Tcl_CmdProc	TestcmdtraceCmd;
static Tcl_CmdProc	TestconcatobjCmd;
static Tcl_CmdProc	TestcreatecommandCmd;
static Tcl_CmdProc	TestdcallCmd;
static Tcl_CmdProc	TestdelCmd;
static Tcl_CmdProc	TestdelassocdataCmd;

static Tcl_ObjCmdProc	TestdoubledigitsObjCmd;
static Tcl_CmdProc	TestdstringCmd;
static Tcl_ObjCmdProc	TestencodingObjCmd;
static Tcl_ObjCmdProc	TestevalexObjCmd;
static Tcl_ObjCmdProc	TestevalobjvObjCmd;
static Tcl_ObjCmdProc	TesteventObjCmd;
static int		TesteventProc(Tcl_Event *event, int flags);







>







223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
static Tcl_CmdProc	TestcmdtokenCmd;
static Tcl_CmdProc	TestcmdtraceCmd;
static Tcl_CmdProc	TestconcatobjCmd;
static Tcl_CmdProc	TestcreatecommandCmd;
static Tcl_CmdProc	TestdcallCmd;
static Tcl_CmdProc	TestdelCmd;
static Tcl_CmdProc	TestdelassocdataCmd;
static Tcl_ObjCmdProc	TestdebugObjCmd;
static Tcl_ObjCmdProc	TestdoubledigitsObjCmd;
static Tcl_CmdProc	TestdstringCmd;
static Tcl_ObjCmdProc	TestencodingObjCmd;
static Tcl_ObjCmdProc	TestevalexObjCmd;
static Tcl_ObjCmdProc	TestevalobjvObjCmd;
static Tcl_ObjCmdProc	TesteventObjCmd;
static int		TesteventProc(Tcl_Event *event, int flags);
261
262
263
264
265
266
267

268
269
270
271
272
273
274
static Tcl_CmdProc	TestpanicCmd;
static Tcl_ObjCmdProc	TestparseargsCmd;
static Tcl_ObjCmdProc	TestparserObjCmd;
static Tcl_ObjCmdProc	TestparsevarObjCmd;
static Tcl_ObjCmdProc	TestparsevarnameObjCmd;
static Tcl_ObjCmdProc	TestpreferstableObjCmd;
static Tcl_ObjCmdProc	TestprintObjCmd;

static Tcl_ObjCmdProc	TestregexpObjCmd;
static Tcl_ObjCmdProc	TestreturnObjCmd;
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
static Tcl_ObjCmdProc	TestsaveresultCmd;
static void		TestsaveresultFree(char *blockPtr);
static Tcl_CmdProc	TestsetassocdataCmd;







>







262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
static Tcl_CmdProc	TestpanicCmd;
static Tcl_ObjCmdProc	TestparseargsCmd;
static Tcl_ObjCmdProc	TestparserObjCmd;
static Tcl_ObjCmdProc	TestparsevarObjCmd;
static Tcl_ObjCmdProc	TestparsevarnameObjCmd;
static Tcl_ObjCmdProc	TestpreferstableObjCmd;
static Tcl_ObjCmdProc	TestprintObjCmd;
static Tcl_ObjCmdProc	TestpurifyObjCmd;
static Tcl_ObjCmdProc	TestregexpObjCmd;
static Tcl_ObjCmdProc	TestreturnObjCmd;
static void		TestregexpXflags(const char *string,
			    int length, int *cflagsPtr, int *eflagsPtr);
static Tcl_ObjCmdProc	TestsaveresultCmd;
static void		TestsaveresultFree(char *blockPtr);
static Tcl_CmdProc	TestsetassocdataCmd;
500
501
502
503
504
505
506


507
508
509
510
511
512
513
    Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);


    Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
			 NULL, NULL);
    Tcl_DStringInit(&dstring);
    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,







>
>







502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
    Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testconcatobj", TestconcatobjCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testcreatecommand", TestcreatecommandCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testdcall", TestdcallCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testdebug", TestdebugObjCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testdel", TestdelCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testdelassocdata", TestdelassocdataCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testdoubledigits", TestdoubledigitsObjCmd,
			 NULL, NULL);
    Tcl_DStringInit(&dstring);
    Tcl_CreateCommand(interp, "testdstring", TestdstringCmd, NULL,
563
564
565
566
567
568
569


570
571
572
573
574
575
576
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,


	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
	    NULL, NULL);







>
>







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testpurify", TestpurifyObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
	    NULL, NULL);
3360
3361
3362
3363
3364
3365
3366


































3367
3368
3369
3370
3371
3372
3373
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *


































 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.
 *
 * Results:
 *	None.







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestdebugObjCmd --
 *
 *	Implements the "testdebug" command, to detect whether Tcl was built with
 *	--enabble-symbols.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestdebugObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{

#if defined(NDEBUG) && NDEBUG == 1
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
#else
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
#endif

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.
 *
 * Results:
 *	None.
3755
3756
3757
3758
3759
3760
3761


































3762
3763
3764
3765
3766
3767
3768
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
    }
    argv2 = (size_t)argv1;
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));


































    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
    }

    if (objc > 1) {
	Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
    }
    argv2 = (size_t)argv1;
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestpurifyObjCmd --
 *
 *	Implements the "testpurify" command, to detect whether Tcl was built with
 *	-DPURIFY.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpurifyObjCmd(
    TCL_UNUSED(void *),
    Tcl_Interp *interp,		/* Current interpreter. */
    TCL_UNUSED(int) /*objc*/,
    TCL_UNUSED(Tcl_Obj *const *) /*objv*/)
{

#ifdef PURIFY
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
#else
	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
#endif

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestregexpObjCmd --
Changes to tests/tcltests.tcl.
1
2
3
4
5










6
7
8
9
10
11
12
#! /usr/bin/env tclsh

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec          [llength [info commands exec]]










testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]
testConstraint thread        [
    expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind   [expr {![testConstraint valgrind]}]







>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
#! /usr/bin/env tclsh

package require tcltest 2.5
namespace import ::tcltest::*
testConstraint exec          [llength [info commands exec]]
testConstraint debug         [testdebug]
testConstraint purify        [testpurify]
testConstraint debugpurify   [
    expr {
	![stestConstraint memory]
	&&
	[testConstraint debug]
	&&
	[testConstraint purify]
}]
testConstraint fcopy         [llength [info commands fcopy]]
testConstraint fileevent     [llength [info commands fileevent]]
testConstraint thread        [
    expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind   [expr {![testConstraint valgrind]}]