Tcl Source Code

Check-in [1671ba2d5c]
Login

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

Overview
Comment:provided test-cases covering crash fixed by [58c46e74b931d3a1], as well as new test-facility "testpurebytesobj" allowing creation pure bytes object without internal representations (NULL).
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | core-8-6-branch
Files: files | file ages | folders
SHA3-256: 1671ba2d5c473dc7eb3c2f7f77f5dd1a5b325439e1bb4255cf75485604fdc6ec
User & Date: sebres 2019-01-11 16:29:24.153
References
2019-08-20
17:47 Ticket [f9a45e58af] Segmentation fault on sqlite tests status still Open with 5 other changes artifact: b943b1f657 user: sebres
2019-01-11
16:37 Ticket [cc1e91552c] Regression in list expansion status still Closed with 4 other changes artifact: c926700098 user: sebres
Context
2019-01-13
15:37
Slightly simpler test for empty string, still covering all cases. Also prepare testpurebytesobj for ... check-in: e94a8f9c8f user: jan.nijtmans tags: core-8-6-branch
2019-01-11
16:29
provided test-cases covering crash fixed by [58c46e74b931d3a1], as well as new test-facility "testpu... check-in: 1671ba2d5c user: sebres tags: core-8-6-branch
14:35
Fix crash reported by reported by François Vogel related to: [cc1e91552c0ca1817292d951f8c694b28c2b2... check-in: 58c46e74b9 user: jan.nijtmans tags: core-8-6-branch
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclTest.c.
216
217
218
219
220
221
222



223
224
225
226
227
228
229
			    Tcl_Obj *const objv[]);
static void		ObjTraceDeleteProc(ClientData clientData);
static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(char *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static int		TestasyncCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);



static int		TestbytestringObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestcmdinfoCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestcmdtokenCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);







>
>
>







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
			    Tcl_Obj *const objv[]);
static void		ObjTraceDeleteProc(ClientData clientData);
static void		PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void		SpecialFree(char *blockPtr);
static int		StaticInitProc(Tcl_Interp *interp);
static int		TestasyncCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestpurebytesobjObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestbytestringObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestcmdinfoCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestcmdtokenCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
566
567
568
569
570
571
572

573
574
575
576
577
578
579
    /*
     * 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_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
	    NULL, NULL);







>







569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
    /*
     * 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_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testsimplefilesystem", TestSimpleFilesystemObjCmd,
	    NULL, NULL);
4951
4952
4953
4954
4955
4956
4957


















































4958
4959
4960
4961
4962
4963
4964
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return TCL_OK;
}



















































/*
 *----------------------------------------------------------------------
 *
 * TestbytestringObjCmd --
 *
 *	This object-based procedure constructs a string which can







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







4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991
4992
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestpurebytesobjObjCmd --
 *
 *	This object-based procedure constructs a pure bytes object
 *	without type and with internal representation containing NULL's.
 *
 *	If no argument supplied it returns empty object with tclEmptyStringRep,
 *	otherwise it returns this as pure bytes object with bytes value equal 
 *	string.
 *
 * Results:
 *	Returns the TCL_OK result code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
TestpurebytesobjObjCmd(
    ClientData unused,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* The argument objects. */
{
    Tcl_Obj *objPtr;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?string?");
	return TCL_ERROR;
    }
    objPtr = Tcl_NewObj();
    /*
    objPtr->internalRep.twoPtrValue.ptr1 = NULL;
    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
    */
    memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
    if (objc == 2) {
    	const char *s = Tcl_GetStringFromObj(objv[1], &objPtr->length);
	objPtr->bytes = ckalloc(objPtr->length + 1);
	memcpy(objPtr->bytes, s, objPtr->length);
	objPtr->bytes[objPtr->length] = 0;
    }
    Tcl_SetObjResult(interp, objPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TestbytestringObjCmd --
 *
 *	This object-based procedure constructs a string which can
Changes to tests/lrange.test.
11
12
13
14
15
16
17






18
19
20
21
22
23
24
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}







test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}







>
>
>
>
>
>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]


test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {
    lrange {a {bcd e {f g {}}} l14 l15 d} 1 1
} {{bcd e {f g {}}}}
113
114
115
116
117
118
119




















120
121
122
123
124
125
126
127
128
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]






















# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:







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









119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
	 [lrange { } 0-1 end+1] [lrange [format %c 32] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b {not compiled on empty not canonical list (with static and dynamic indices), regression test, bug [cc1e91552c]} {
    set cmd lrange
    list [$cmd { } 0 1] [$cmd [format %c 32] 0 1] [$cmd [set a { }] 0 1] \
	 [$cmd { } 0-1 end+1] [$cmd [format %c 32] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]
# following 4 tests could cause a segfault on empty non-lists with tclEmptyStringRep
# (as before the fix [58c46e74b931d3a1]):
test lrange-3.7a.2 {compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
    list [lrange {} 0 1] [lrange [lindex a -1] 0 1] [lrange [set a {}] 0 1] \
	 [lrange {} 0-1 end+1] [lrange [lindex a -1] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7b.2 {not compiled on empty not list object, 2nd regression test, bug [cc1e91552c]} {
    set cmd lrange
    list [$cmd {} 0 1] [$cmd [lindex a -1] 0 1] [$cmd [set a {}] 0 1] \
	 [$cmd {} 0-1 end+1] [$cmd [lindex a -1] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7c.2 {compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
    list [lrange [testpurebytesobj] 0 1] [lrange [testpurebytesobj { }] 0 1] [lrange [set a [testpurebytesobj {}]] 0 1] \
	 [lrange [testpurebytesobj] 0-1 end+1] [lrange [testpurebytesobj { }] 0-1 end+1] [lrange $a 0-1 end+1]
} [lrepeat 6 {}]
test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test, bug [cc1e91552c]} {
    set cmd lrange
    list [$cmd [testpurebytesobj] 0 1] [$cmd [testpurebytesobj { }] 0 1] [$cmd [set a [testpurebytesobj {}]] 0 1] \
	 [$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]


# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: