Tcl Source Code

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

Changes to ChangeLog.

            1  +2005-09-01  Don Porter  <[email protected]>
            2  +
            3  +	[kennykb-numerics-branch]
            4  +
            5  +	* generic/tclScan.c:	Extended [scan] to accept the %lld,
            6  +	%llo, %llx, and %lli formats.  Numeric scanning is now done
            7  +	via TclParseNumber calls.
            8  +
            9  +	* generic/tclInt.h:	Extended TclParseNumber to accept new flag
           10  +	* generic/tclStrToD.c:	values TCL_PARSE_INTEGER_ONLY,
           11  +	TCL_PARSE_OCTAL_ONLY, and TCL_PARSE_HEXIDECIMAL_ONLY, to give caller
           12  +	more control over the parsing rules.
           13  +
     1     14   2005-08-30  Don Porter  <[email protected]>
     2     15   
     3     16   	[kennykb-numerics-branch]
     4     17   
     5     18   	* generic/tclObj.c:	Extended bignum support to include bignums
     6     19   	so large they will not pack into a Tcl_Obj.  When they outgrow Tcl's
     7     20   	string rep length limits, a panic will result.

Changes to generic/tclInt.h.

     8      8    * Copyright (c) 1994-1998 Sun Microsystems, Inc.
     9      9    * Copyright (c) 1998-19/99 by Scriptics Corporation.
    10     10    * Copyright (c) 2001, 2002 by Kevin B. Kenny.  All rights reserved.
    11     11    *
    12     12    * See the file "license.terms" for information on usage and redistribution of
    13     13    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    14     14    *
    15         - * RCS: @(#) $Id: tclInt.h,v 1.202.2.35 2005/08/29 18:38:45 dgp Exp $
           15  + * RCS: @(#) $Id: tclInt.h,v 1.202.2.36 2005/09/01 16:09:56 dgp Exp $
    16     16    */
    17     17   
    18     18   #ifndef _TCLINT
    19     19   #define _TCLINT
    20     20   
    21     21   /*
    22     22    * Some numerics configuration options
................................................................................
  1887   1887    *----------------------------------------------------------------------
  1888   1888    * Flags for TclParseNumber
  1889   1889    *----------------------------------------------------------------------
  1890   1890    */
  1891   1891   
  1892   1892   #define TCL_PARSE_DECIMAL_ONLY 1
  1893   1893   				/* Leading zero doesn't denote octal or hex */
         1894  +#define TCL_PARSE_OCTAL_ONLY 2	/* Parse octal even without prefix */
         1895  +#define TCL_PARSE_HEXADECIMAL_ONLY 4
         1896  +				/* Parse hexadecimal even without prefix */
         1897  +#define TCL_PARSE_INTEGER_ONLY 8
         1898  +				/* Disable floating point parsing */
  1894   1899   
  1895   1900   /*
  1896   1901    *----------------------------------------------------------------
  1897   1902    * Variables shared among Tcl modules but not used by the outside world.
  1898   1903    *----------------------------------------------------------------
  1899   1904    */
  1900   1905   

Changes to generic/tclScan.c.

     4      4    *	This file contains the implementation of the "scan" command.
     5      5    *
     6      6    * Copyright (c) 1998 by Scriptics Corporation.
     7      7    *
     8      8    * See the file "license.terms" for information on usage and redistribution of
     9      9    * this file, and for a DISCLAIMER OF ALL WARRANTIES.
    10     10    *
    11         - * RCS: @(#) $Id: tclScan.c,v 1.16.2.3 2005/08/23 18:28:51 kennykb Exp $
           11  + * RCS: @(#) $Id: tclScan.c,v 1.16.2.4 2005/09/01 16:09:57 dgp Exp $
    12     12    */
    13     13   
    14     14   #include "tclInt.h"
    15     15   
    16     16   /*
    17     17    * Flag values used by Tcl_ScanObjCmd.
    18     18    */
    19     19   
    20     20   #define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
    21     21   #define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
    22     22   #define SCAN_UNSIGNED	0x4		/* Read an unsigned value. */
    23     23   #define SCAN_WIDTH	0x8		/* A width value was supplied. */
    24     24   
           25  +#if 0
    25     26   #define SCAN_SIGNOK	0x10		/* A +/- character is allowed. */
    26     27   #define SCAN_NODIGITS	0x20		/* No digits have been scanned. */
    27     28   #define SCAN_NOZERO	0x40		/* No zero digits have been scanned. */
    28     29   #define SCAN_XOK	0x80		/* An 'x' is allowed. */
    29     30   #define SCAN_PTOK	0x100		/* Decimal point is allowed. */
    30     31   #define SCAN_EXPOK	0x200		/* An exponent is allowed. */
           32  +#endif
    31     33   
    32     34   #define SCAN_LONGER	0x400		/* Asked for a wide value. */
           35  +#define SCAN_BIG	0x800		/* Asked for a bignum value. */
    33     36   
    34     37   /*
    35     38    * The following structure contains the information associated with a
    36     39    * character set.
    37     40    */
    38     41   
    39     42   typedef struct CharSet {
................................................................................
   362    365   
   363    366   	/*
   364    367   	 * Handle any size specifier.
   365    368   	 */
   366    369   
   367    370   	switch (ch) {
   368    371   	case 'l':
          372  +	    if (*format == 'l') {
          373  +		flags |= SCAN_BIG;
          374  +		format += 1;
          375  +		format += Tcl_UtfToUniChar(format, &ch);
          376  +		break;
          377  +	    }
   369    378   	case 'L':
   370    379   	    flags |= SCAN_LONGER;
   371    380   	case 'h':
   372    381   	    format += Tcl_UtfToUniChar(format, &ch);
   373    382   	}
   374    383   
   375    384   	if (!(flags & SCAN_SUPPRESS) && numVars && (objIndex >= numVars)) {
................................................................................
   389    398   		goto error;
   390    399   	    }
   391    400   	    /*
   392    401   	     * Fall through!
   393    402   	     */
   394    403   	case 'n':
   395    404   	case 's':
   396         -	    if (flags & SCAN_LONGER) {
   397         -	    invalidLonger:
          405  +	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
          406  +	    invalidFieldSize:
   398    407   		buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
   399    408   		Tcl_AppendResult(interp,
   400         -			"'l' modifier may not be specified in %", buf,
          409  +			"field size modifier may not be specified in %", buf,
   401    410   			" conversion", NULL);
   402    411   		goto error;
   403    412   	    }
   404    413   	    /*
   405    414   	     * Fall through!
   406    415   	     */
   407    416   	case 'd':
   408    417   	case 'e':
   409    418   	case 'f':
   410    419   	case 'g':
   411    420   	case 'i':
   412    421   	case 'o':
   413         -	case 'u':
   414    422   	case 'x':
          423  +	    break;
          424  +	case 'u':
          425  +	    if (flags & SCAN_BIG) {
          426  +		Tcl_SetResult(interp,
          427  +			"unsigned bignum scans are invalid", TCL_STATIC);
          428  +		goto error;
          429  +	    }
   415    430   	    break;
   416    431   	    /*
   417    432   	     * Bracket terms need special checking
   418    433   	     */
   419    434   	case '[':
   420         -	    if (flags & SCAN_LONGER) {
   421         -		goto invalidLonger;
          435  +	    if (flags & (SCAN_LONGER|SCAN_BIG)) {
          436  +		goto invalidFieldSize;
   422    437   	    }
   423    438   	    if (*format == '\0') {
   424    439   		goto badSet;
   425    440   	    }
   426    441   	    format += Tcl_UtfToUniChar(format, &ch);
   427    442   	    if (ch == '^') {
   428    443   		if (*format == '\0') {
................................................................................
   570    585       int objc;			/* Number of arguments. */
   571    586       Tcl_Obj *CONST objv[];	/* Argument objects. */
   572    587   {
   573    588       char *format;
   574    589       int numVars, nconversions, totalVars = -1;
   575    590       int objIndex, offset, i, result, code;
   576    591       long value;
   577         -    char *string, *end, *baseString;
          592  +    CONST char *string, *end, *baseString;
   578    593       char op = 0;
   579         -    int base = 0;
   580    594       int underflow = 0;
   581    595       size_t width;
   582         -    long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL;
   583         -#ifndef TCL_WIDE_INT_IS_LONG
   584         -    Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL;
   585    596       Tcl_WideInt wideValue;
   586         -#endif
   587    597       Tcl_UniChar ch, sch;
   588    598       Tcl_Obj **objs = NULL, *objPtr = NULL;
   589    599       int flags;
   590    600       char buf[513];		/* Temporary buffer to hold scanned number
   591    601   				 * strings before they are passed to
   592    602   				 * strtoul. */
          603  +#if 0
          604  +    int base = 0;
          605  +    long (*fn) _ANSI_ARGS_((char*,void*,int)) = NULL;
          606  +#ifndef TCL_WIDE_INT_IS_LONG
          607  +    Tcl_WideInt (*lfn) _ANSI_ARGS_((char*,void*,int)) = NULL;
          608  +#endif
          609  +#endif
   593    610   
   594    611       if (objc < 3) {
   595    612   	Tcl_WrongNumArgs(interp, 1, objv,
   596    613   		"string format ?varName varName ...?");
   597    614   	return TCL_ERROR;
   598    615       }
   599    616   
................................................................................
   627    644        * reach the end of input, the end of the format string, or there is a
   628    645        * mismatch.
   629    646        */
   630    647   
   631    648       objIndex = 0;
   632    649       nconversions = 0;
   633    650       while (*format != '\0') {
          651  +	int parseFlag = 0;
   634    652   	format += Tcl_UtfToUniChar(format, &ch);
   635    653   
   636    654   	flags = 0;
   637    655   
   638    656   	/*
   639    657   	 * If we see whitespace in the format, skip whitespace in the string.
   640    658   	 */
................................................................................
   674    692   	 * ('%n$').
   675    693   	 */
   676    694   
   677    695   	if (ch == '*') {
   678    696   	    flags |= SCAN_SUPPRESS;
   679    697   	    format += Tcl_UtfToUniChar(format, &ch);
   680    698   	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
   681         -	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
   682         -	    if (*end == '$') {
   683         -		format = end+1;
          699  +	    char *formatEnd;
          700  +	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
          701  +	    if (*formatEnd == '$') {
          702  +		format = formatEnd+1;
   684    703   		format += Tcl_UtfToUniChar(format, &ch);
   685    704   		objIndex = (int) value - 1;
   686    705   	    }
   687    706   	}
   688    707   
   689    708   	/*
   690    709   	 * Parse any width specifier.
................................................................................
   699    718   
   700    719   	/*
   701    720   	 * Handle any size specifier.
   702    721   	 */
   703    722   
   704    723   	switch (ch) {
   705    724   	case 'l':
          725  +	    if (*format == 'l') {
          726  +		flags |= SCAN_BIG;
          727  +		format += 1;
          728  +		format += Tcl_UtfToUniChar(format, &ch);
          729  +		break;
          730  +	    }
   706    731   	case 'L':
   707    732   	    flags |= SCAN_LONGER;
   708    733   	    /*
   709    734   	     * Fall through so we skip to the next character.
   710    735   	     */
   711    736   	case 'h':
   712    737   	    format += Tcl_UtfToUniChar(format, &ch);
................................................................................
   724    749   		objs[objIndex++] = objPtr;
   725    750   	    }
   726    751   	    nconversions++;
   727    752   	    continue;
   728    753   
   729    754   	case 'd':
   730    755   	    op = 'i';
          756  +	    parseFlag = TCL_PARSE_DECIMAL_ONLY;
          757  +#if 0
   731    758   	    base = 10;
   732    759   	    fn = (long (*) _ANSI_ARGS_((char*,void*,int)))strtol;
   733    760   #ifndef TCL_WIDE_INT_IS_LONG
   734    761   	    lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
          762  +#endif
   735    763   #endif
   736    764   	    break;
   737    765   	case 'i':
   738    766   	    op = 'i';
          767  +#if 0
   739    768   	    base = 0;
   740    769   	    fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtol;
   741    770   #ifndef TCL_WIDE_INT_IS_LONG
   742    771   	    lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoll;
          772  +#endif
   743    773   #endif
   744    774   	    break;
   745    775   	case 'o':
   746    776   	    op = 'i';
          777  +	    parseFlag = TCL_PARSE_OCTAL_ONLY;
          778  +#if 0
   747    779   	    base = 8;
   748    780   	    fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
   749    781   #ifndef TCL_WIDE_INT_IS_LONG
   750    782   	    lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
          783  +#endif
   751    784   #endif
   752    785   	    break;
   753    786   	case 'x':
   754    787   	    op = 'i';
          788  +	    parseFlag = TCL_PARSE_HEXADECIMAL_ONLY;
          789  +#if 0
   755    790   	    base = 16;
   756    791   	    fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
   757    792   #ifndef TCL_WIDE_INT_IS_LONG
   758    793   	    lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
          794  +#endif
   759    795   #endif
   760    796   	    break;
   761    797   	case 'u':
   762    798   	    op = 'i';
   763         -	    base = 10;
   764    799   	    flags |= SCAN_UNSIGNED;
          800  +#if 0
          801  +	    base = 10;
   765    802   	    fn = (long (*)_ANSI_ARGS_((char*,void*,int)))strtoul;
   766    803   #ifndef TCL_WIDE_INT_IS_LONG
   767    804   	    lfn = (Tcl_WideInt (*)_ANSI_ARGS_((char*,void*,int)))strtoull;
          805  +#endif
   768    806   #endif
   769    807   	    break;
   770    808   
   771    809   	case 'f':
   772    810   	case 'e':
   773    811   	case 'g':
   774    812   	    op = 'f';
................................................................................
   899    937   	    break;
   900    938   
   901    939   	case 'i':
   902    940   	    /*
   903    941   	     * Scan an unsigned or signed integer.
   904    942   	     */
   905    943   
          944  +#if 0
   906    945   	    if ((width == 0) || (width > sizeof(buf) - 1)) {
   907    946   		width = sizeof(buf) - 1;
   908    947   	    }
   909    948   	    flags |= SCAN_SIGNOK | SCAN_NODIGITS | SCAN_NOZERO;
   910    949   	    for (end = buf; width > 0; width--) {
   911    950   		switch (*string) {
   912    951   		    /*
................................................................................
  1045   1084   		}
  1046   1085   #endif
  1047   1086   		Tcl_IncrRefCount(objPtr);
  1048   1087   		objs[objIndex++] = objPtr;
  1049   1088   	    }
  1050   1089   
  1051   1090   	    break;
         1091  +#else
         1092  +	    objPtr = Tcl_NewLongObj(0);
         1093  +	    Tcl_IncrRefCount(objPtr);
         1094  +	    if (width == 0) {
         1095  +		width = -1;
         1096  +	    }
         1097  +	    if (TclParseNumber(NULL, objPtr, NULL, string, width, &end,
         1098  +		    TCL_PARSE_INTEGER_ONLY | parseFlag) != TCL_OK) {
         1099  +		Tcl_DecrRefCount(objPtr);
         1100  +		/* TODO: set underflow?  test scan-4.44 */
         1101  +		goto done;
         1102  +	    }
         1103  +	    string = end;
         1104  +	    if (flags & SCAN_SUPPRESS) {
         1105  +		Tcl_DecrRefCount(objPtr);
         1106  +		break;
         1107  +	    }
         1108  +	    if (flags & SCAN_LONGER) {
         1109  +		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {		    wideValue = ~(Tcl_WideUInt)0 >> 1;	/* WIDE_MAX */
         1110  +		    if (Tcl_GetString(objPtr)[0] == '-') {
         1111  +			wideValue++;	/* WIDE_MAX + 1 = WIDE_MIN */
         1112  +		    }
         1113  +		}
         1114  +		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
         1115  +		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
         1116  +			    (Tcl_WideUInt)wideValue);
         1117  +		    Tcl_SetStringObj(objPtr, buf, -1);
         1118  +		} else {
         1119  +		    Tcl_SetWideIntObj(objPtr, wideValue);
         1120  +		}
         1121  +	    } else if (!(flags & SCAN_BIG)) {
         1122  +		if (Tcl_GetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
         1123  +		    if (Tcl_GetString(objPtr)[0] == '-') {
         1124  +			value = LONG_MIN;
         1125  +		    } else {
         1126  +			value = LONG_MAX;
         1127  +		    }
         1128  +		}
         1129  +		if ((flags & SCAN_UNSIGNED) && (value < 0)) {
         1130  +		    sprintf(buf, "%lu", value);	/* INTL: ISO digit */
         1131  +		    Tcl_SetStringObj(objPtr, buf, -1);
         1132  +		} else {
         1133  +		    Tcl_SetLongObj(objPtr, value);
         1134  +		}
         1135  +	    }
         1136  +	    objs[objIndex++] = objPtr;
         1137  +	    break;
         1138  +#endif
  1052   1139   
  1053   1140   	case 'f':
  1054   1141   	    /*
  1055   1142   	     * Scan a floating point number
  1056   1143   	     */
  1057   1144   
  1058         -	    flags &= ~SCAN_LONGER;
  1059         -	    objPtr = Tcl_NewObj();
         1145  +	    objPtr = Tcl_NewDoubleObj(0.0);
  1060   1146   	    Tcl_IncrRefCount(objPtr);
  1061   1147   	    if (width == 0) {
  1062   1148   		width = -1;
  1063   1149   	    }
  1064         -	    if (TclParseNumber(NULL, objPtr, "", string, width, &end,
         1150  +	    if (TclParseNumber(NULL, objPtr, NULL, string, width, &end,
  1065   1151   			       TCL_PARSE_DECIMAL_ONLY) != TCL_OK) {
         1152  +		/* TODO: set underflow?  test scan-4.55 */
  1066   1153   		Tcl_DecrRefCount(objPtr);
  1067   1154   		goto done;
  1068   1155   	    } else if (flags & SCAN_SUPPRESS) {
  1069   1156   		Tcl_DecrRefCount(objPtr);
  1070   1157   		string = end;
  1071   1158   	    } else {
  1072   1159   		double dvalue;
  1073   1160   		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
         1161  +#ifdef ACCEPT_NAN
         1162  +		    if (objPtr->typePtr == &tclDoubleType) {
         1163  +			dValue = objPtr->internalRep.doubleValue;
         1164  +		    } else
         1165  +#endif
         1166  +		    {
  1074   1167   		    Tcl_DecrRefCount(objPtr);
  1075   1168   		    goto done;
         1169  +		    }
  1076   1170   		}
  1077   1171   		Tcl_SetDoubleObj(objPtr, dvalue);
  1078   1172   		objs[objIndex++] = objPtr;
  1079   1173   		string = end;
  1080   1174   	    }
  1081   1175   	}
  1082   1176   	nconversions++;

Changes to generic/tclStrToD.c.

    10     10    *	interconversion among 'double' and 'mp_int' types.
    11     11    *
    12     12    * Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
    13     13    *
    14     14    * See the file "license.terms" for information on usage and redistribution
    15     15    * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    16     16    *
    17         - * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.34 2005/08/24 21:49:23 dgp Exp $
           17  + * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.35 2005/09/01 16:09:57 dgp Exp $
    18     18    *
    19     19    *----------------------------------------------------------------------
    20     20    */
    21     21   
    22     22   #include <tclInt.h>
    23     23   #include <stdio.h>
    24     24   #include <stdlib.h>
................................................................................
   334    334   	    if (c == '0') {
   335    335   		if (flags & TCL_PARSE_DECIMAL_ONLY) {
   336    336   		    state = DECIMAL;
   337    337   		} else {
   338    338   		    state = ZERO;
   339    339   		}
   340    340   		break;
          341  +	    } else if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
          342  +		goto zerox;
          343  +	    } else if (flags & TCL_PARSE_OCTAL_ONLY) {
          344  +		goto zeroo;
   341    345   	    } else if (isdigit(UCHAR(c))) {
   342    346   		significandWide = c - '0';
   343    347   		numSigDigs = 1;
   344    348   		state = DECIMAL;
   345    349   		break;
          350  +	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
          351  +		goto endgame;
   346    352   	    } else if (c == '.') {
   347    353   		state = LEADING_RADIX_POINT;
   348    354   		break;
   349    355   	    } else if (c == 'I' || c == 'i') {
   350    356   		state = sI;
   351    357   		break;
   352    358   #ifdef IEEE_FLOATING_POINT
................................................................................
   379    385   	    }
   380    386   	    if (c == 'o' || c == 'O') {
   381    387   		explicitOctal = 1;
   382    388   		state = ZERO_O;
   383    389   		break;
   384    390   	    }
   385    391   #endif
          392  +	    if (flags & TCL_PARSE_HEXADECIMAL_ONLY) {
          393  +		goto zerox;
          394  +	    }
   386    395   #ifdef KILL_OCTAL
   387    396   	    goto decimal;
   388    397   #endif
   389    398   	    /* FALLTHROUGH */
   390    399   
   391    400   	case OCTAL:
   392    401   	    /*
................................................................................
   398    407   	    acceptState = state;
   399    408   	    acceptPoint = p;
   400    409   	    acceptLen = len;
   401    410   #ifdef TIP_114_FORMATS
   402    411   	    /* FALLTHROUGH */
   403    412   	case ZERO_O:
   404    413   #endif
          414  +	zeroo:
   405    415   	    if (c == '0') {
   406    416   		++numTrailZeros;
   407    417   		state = OCTAL;
   408    418   		break;
   409    419   	    } else if (c >= '1' && c <= '7') {
   410    420   		if (objPtr != NULL) {
   411    421   		    shift = 3 * (numTrailZeros + 1);
................................................................................
   455    465   	case BAD_OCTAL:
   456    466   #ifdef TIP_114_FORMATS
   457    467   	    if (explicitOctal) {
   458    468   		/* No forgiveness for bad digits in explicitly octal numbers */
   459    469   		goto endgame;
   460    470   	    }
   461    471   #endif
          472  +	    if (flags & TCL_PARSE_INTEGER_ONLY) {
          473  +		/* No seeking floating point when parsing only integer */
          474  +		goto endgame;
          475  +	    }
   462    476   #ifndef KILL_OCTAL
   463    477   	    /*
   464    478   	     * Scanned a number with a leading zero that contains an
   465    479   	     * 8, 9, radix point or E.  This is an invalid octal number,
   466    480   	     * but might still be floating point.  
   467    481   	     */
   468    482   	    if (c == '0') {
................................................................................
   503    517   	     */
   504    518   	case HEXADECIMAL:
   505    519   	    acceptState = state;
   506    520   	    acceptPoint = p;
   507    521   	    acceptLen = len;
   508    522   	    /* FALLTHROUGH */
   509    523   	case ZERO_X:
          524  +	zerox:
   510    525   	    if (c == '0') {
   511    526   		++numTrailZeros;
   512    527   		state = HEXADECIMAL;
   513    528   		break;
   514    529   	    } else if (isdigit(UCHAR(c))) {
   515    530   		d = (c-'0');
   516    531   	    } else if (c >= 'A' && c <= 'F') {
................................................................................
   618    633   					       &significandBig, 
   619    634   					       significandOverflow);
   620    635   		}
   621    636   		numSigDigs += ( numTrailZeros + 1 );
   622    637   		numTrailZeros = 0;
   623    638   		state = DECIMAL;
   624    639   		break;
          640  +	    } else if (flags & TCL_PARSE_INTEGER_ONLY) {
          641  +		goto endgame;
   625    642   	    } else if (c == '.') {
   626    643   		state = FRACTION;
   627    644   		break;
   628    645   	    } else if (c == 'E' || c == 'e') {
   629    646   		state = EXPONENT_START;
   630    647   		break;
   631    648   	    }