Tcl Source Code

Check-in [df23d89ed4]
Login

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

Overview
Comment:faster memleak-free implementation of [string is entier]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: df23d89ed4dd5bdb755f3ad29cb5ea753f766db9
User & Date: jan.nijtmans 2012-03-29 08:38:01
Context
2012-03-29
09:24
Fix minor typos in ChangeLog messages. check-in: e9858729dc user: dkf tags: trunk
08:38
faster memleak-free implementation of [string is entier] check-in: df23d89ed4 user: jan.nijtmans tags: trunk
2012-03-27
14:26
se lower numbers, preventing integer overflow in tclWinError.c check-in: f38a3c4d81 user: jan.nijtmans tags: trunk
2012-01-26
23:26
alternative TIP 395 implementation: - more efficient, will not generate bignum - uses "string is int... Closed-Leaf check-in: 9969397e80 user: jan.nijtmans tags: tip-395-with-alt-name
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7





2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#395.

	* generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
	entier] check. Code by Jos Decoster.

>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2012-03-29  Jan Nijtmans  <[email protected]>

	* generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free
	implementation of [string is entier]
 
2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#395.

	* generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
	entier] check. Code by Jos Decoster.

Changes to generic/tclCmdMZ.c.

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

#include "tclInt.h"
#include "tclRegexp.h"
#include "tommath.h"

static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static int		SwitchPostProc(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		TryPostBody(ClientData data[], Tcl_Interp *interp,
			    int result);







<







14
15
16
17
18
19
20

21
22
23
24
25
26
27
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclRegexp.h"


static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
static int		SwitchPostProc(ClientData data[], Tcl_Interp *interp,
			    int result);
static int		TryPostBody(ClientData data[], Tcl_Interp *interp,
			    int result);
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
{
    const char *string1, *end, *stop;
    Tcl_UniChar ch;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;
    mp_int big;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",







<







1429
1430
1431
1432
1433
1434
1435

1436
1437
1438
1439
1440
1441
1442
{
    const char *string1, *end, *stop;
    Tcl_UniChar ch;
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;


    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",
1575
1576
1577
1578
1579
1580
1581





















1582
1583







1584








1585




1586
1587
1588
1589
1590
1591
1592
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;
    case STR_IS_ENTIER:





















	if (TCL_OK == Tcl_GetBignumFromObj(NULL, objPtr, &big)) {
	    break;







	}








	goto failedIntParse;




    case STR_IS_WIDE:
	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
|
>
>
>
>







1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;
    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
#ifndef NO_WIDE_TYPE
		(objPtr->typePtr == &tclWideIntType) ||
#endif
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer.
		 */

		break;
	    } else {
		/*
		 * Some prefix parsed as an integer, but not the whole string,
		 * so return failure index as the point where parsing stopped.
		 * Clear out the internal rep, since keeping it would leave
		 * *objPtr in an inconsistent state.
		 */

		result = 0;
		failat = stop - string1;
		TclFreeIntRep(objPtr);
	    }
	} else {
	    /*
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    result = 0;
	    failat = 0;
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);