Tcl Source Code

Check-in [8b66d9f360]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:Merge trunk through 2019-01-26
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | dgp-refactor
Files: files | file ages | folders
SHA3-256:8b66d9f360b5d71b32ddc950bb02fa02e3f76d3bef35c6ee52043cd716b4f8b8
User & Date: dgp 2019-02-13 21:14:14
Context
2019-02-13
21:24
Merge trunk through 2019-02-01 check-in: 76fa1ad734 user: dgp tags: dgp-refactor
21:14
Merge trunk through 2019-01-26 check-in: 8b66d9f360 user: dgp tags: dgp-refactor
20:14
Merge trunk through 2019-01-25 check-in: 495691b47d user: dgp tags: dgp-refactor
2019-01-26
17:32
Merge 8.7 check-in: 2d39bcaeac user: jan.nijtmans tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to compat/strtol.c.

    49     49       long result;
    50     50   
    51     51       /*
    52     52        * Skip any leading blanks.
    53     53        */
    54     54   
    55     55       p = string;
    56         -    while (isspace(UCHAR(*p))) {
           56  +    while (TclIsSpaceProc(*p)) {
    57     57   	p += 1;
    58     58       }
    59     59   
    60     60       /*
    61     61        * Check for a sign.
    62     62        */
    63     63   

Changes to compat/strtoul.c.

    70     70       int overflow=0;
    71     71   
    72     72       /*
    73     73        * Skip any leading blanks.
    74     74        */
    75     75   
    76     76       p = string;
    77         -    while (isspace(UCHAR(*p))) {
           77  +    while (TclIsSpaceProc(*p)) {
    78     78   	p += 1;
    79     79       }
    80     80       if (*p == '-') {
    81     81           negative = 1;
    82     82           p += 1;
    83     83       } else {
    84     84           if (*p == '+') {

Changes to generic/tcl.h.

   623    623   typedef union Tcl_ObjIntRep {	/* The internal representation: */
   624    624       long longValue;		/*   - an long integer value. */
   625    625       double doubleValue;		/*   - a double-precision floating value. */
   626    626       void *otherValuePtr;	/*   - another, type-specific value, */
   627    627   				/*     not used internally any more. */
   628    628       Tcl_WideInt wideValue;	/*   - an integer value >= 64bits */
   629    629       struct {			/*   - internal rep as two pointers. */
   630         -	void *ptr1;		
          630  +	void *ptr1;
   631    631   	void *ptr2;
   632    632       } twoPtrValue;
   633    633       struct {			/*   - internal rep as a pointer and a long, */
   634    634   	void *ptr;		/*     not used internally any more. */
   635    635   	unsigned long value;
   636    636       } ptrAndLongRep;
   637    637   } Tcl_ObjIntRep;

Changes to generic/tclInt.h.

  3096   3096   MODULE_SCOPE void	TclInitIOSubsystem(void);
  3097   3097   MODULE_SCOPE void	TclInitLimitSupport(Tcl_Interp *interp);
  3098   3098   MODULE_SCOPE void	TclInitNamespaceSubsystem(void);
  3099   3099   MODULE_SCOPE void	TclInitNotifier(void);
  3100   3100   MODULE_SCOPE void	TclInitObjSubsystem(void);
  3101   3101   MODULE_SCOPE void	TclInitSubsystems(void);
  3102   3102   MODULE_SCOPE int	TclInterpReady(Tcl_Interp *interp);
  3103         -MODULE_SCOPE int	TclIsSpaceProc(char byte);
  3104         -MODULE_SCOPE int	TclIsBareword(char byte);
         3103  +MODULE_SCOPE int	TclIsSpaceProc(int byte);
         3104  +MODULE_SCOPE int	TclIsBareword(int byte);
  3105   3105   MODULE_SCOPE Tcl_Obj *	TclJoinPath(int elements, Tcl_Obj * const objv[],
  3106   3106   			    int forceRelative);
  3107   3107   MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
  3108   3108   MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
  3109   3109   MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
  3110   3110   			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
  3111   3111   MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
................................................................................
  5004   5004   	_objPtr->bytes = NULL;						\
  5005   5005   	_objPtr->typePtr = NULL;					\
  5006   5006   	_objPtr->refCount = 1;						\
  5007   5007   	TclDecrRefCount(_objPtr);					\
  5008   5008       } while (0)
  5009   5009   #endif   /* TCL_MEM_DEBUG */
  5010   5010   
  5011         -/* 
  5012         - * Macros to convert size_t to wide-int (and wide-int object) considering 
  5013         - * platform-related negative value ((size_t)-1), if wide-int and size_t 
  5014         - * have different dimensions (e. g. 32-bit platform). 
         5011  +/*
         5012  + * Macros to convert size_t to wide-int (and wide-int object) considering
         5013  + * platform-related negative value ((size_t)-1), if wide-int and size_t
         5014  + * have different dimensions (e. g. 32-bit platform).
  5015   5015    */
  5016   5016   
  5017   5017   #if (!defined(TCL_WIDE_INT_IS_LONG) || (LONG_MAX > UINT_MAX)) && (SIZE_MAX <= UINT_MAX)
  5018   5018   #   define TclWideIntFromSize(value)	(((Tcl_WideInt)(((size_t)(value))+1))-1)
  5019   5019   #   define TclNewWideIntObjFromSize(value) \
  5020   5020   	Tcl_NewWideIntObj(TclWideIntFromSize(value))
  5021   5021   #else

Changes to generic/tclLiteral.c.

   205    205       if (length == TCL_AUTO_LENGTH) {
   206    206   	length = strlen(bytes);
   207    207       }
   208    208       globalHash = (HashString(bytes, length) & globalTablePtr->mask);
   209    209       for (globalPtr=globalTablePtr->buckets[globalHash] ; globalPtr!=NULL;
   210    210   	    globalPtr = globalPtr->nextPtr) {
   211    211   	objPtr = globalPtr->objPtr;
   212         -	if ((globalPtr->nsPtr == nsPtr)
   213         -		&& ((size_t)objPtr->length == length) && ((length == 0)
   214         -		|| ((objPtr->bytes[0] == bytes[0])
   215         -		&& (memcmp(objPtr->bytes, bytes, length) == 0)))) {
          212  +	if (globalPtr->nsPtr == nsPtr) {
   216    213   	    /*
   217         -	     * A literal was found: return it
          214  +	     * Literals should always have UTF-8 representations... but this
          215  +	     * is not guaranteed so we need to be careful anyway.
          216  +	     *
          217  +	     * https://stackoverflow.com/q/54337750/301832
   218    218   	     */
   219    219   
   220         -	    if (newPtr) {
   221         -		*newPtr = 0;
   222         -	    }
   223         -	    if ((flags & LITERAL_ON_HEAP)) {
   224         -		Tcl_Free((void *)bytes);
   225         -	    }
   226         -	    if (globalPtrPtr) {
   227         -		*globalPtrPtr = globalPtr;
   228         -	    } else {
   229         -		globalPtr->refCount++;
          220  +	    size_t objLength;
          221  +	    char *objBytes = TclGetStringFromObj(objPtr, &objLength);
          222  +
          223  +	    if ((objLength == length) && ((length == 0)
          224  +		    || ((objBytes[0] == bytes[0])
          225  +		    && (memcmp(objBytes, bytes, length) == 0)))) {
          226  +		/*
          227  +		 * A literal was found: return it
          228  +		 */
          229  +
          230  +		if (newPtr) {
          231  +		    *newPtr = 0;
          232  +		}
          233  +		if ((flags & LITERAL_ON_HEAP)) {
          234  +		    Tcl_Free((void *)bytes);
          235  +		}
          236  +		if (globalPtrPtr) {
          237  +		    *globalPtrPtr = globalPtr;
          238  +		} else {
          239  +		    globalPtr->refCount++;
   230    240   #ifdef TCL_COMPILE_DEBUG
   231    241       if (globalPtr->refCount + 1 < 2) {
   232    242   	Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
   233    243   		"TclRegisterLiteral", (length>60? 60 : length), bytes,
   234    244   		globalPtr->refCount);
   235    245       }
   236    246   #endif
          247  +		}
          248  +		return objPtr;
   237    249   	    }
   238         -	    return objPtr;
   239    250   	}
   240    251       }
   241    252       if (newPtr == NULL) {
   242    253   	if ((flags & LITERAL_ON_HEAP)) {
   243    254   	    Tcl_Free((void *)bytes);
   244    255   	}
   245    256   	return NULL;

Changes to generic/tclObj.c.

  1697   1697    *	This function is called in several configurations to provide all
  1698   1698    *	the tools needed to set an object's string representation. The
  1699   1699    *	function is determined by the arguments.
  1700   1700    *
  1701   1701    *	(objPtr->bytes != NULL && bytes != NULL) || (numBytes == -1)
  1702   1702    *	    Invalid call -- panic!
  1703   1703    *
  1704         - *	objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
         1704  + *	objPtr->bytes == NULL && bytes == NULL && numBytes != -1
  1705   1705    *	    Allocation only - allocate space for (numBytes+1) chars.
  1706   1706    *	    store in objPtr->bytes and return. Also sets
  1707   1707    *	    objPtr->length to 0 and objPtr->bytes[0] to NUL.
  1708   1708    *
  1709         - *	objPtr->bytes == NULL && bytes != NULL && numBytes >= 0
         1709  + *	objPtr->bytes == NULL && bytes != NULL && numBytes != -1
  1710   1710    *	    Allocate and copy. bytes is assumed to point to chars to
  1711   1711    *	    copy into the string rep. objPtr->length = numBytes. Allocate
  1712   1712    *	    array of (numBytes + 1) chars. store in objPtr->bytes. Copy
  1713   1713    *	    numBytes chars from bytes to objPtr->bytes; Set
  1714   1714    *	    objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
  1715   1715    *	    Caller must guarantee there are numBytes chars at bytes to
  1716   1716    *	    be copied.
  1717   1717    *
  1718         - *	objPtr->bytes != NULL && bytes == NULL && numBytes >= 0
         1718  + *	objPtr->bytes != NULL && bytes == NULL && numBytes != -1
  1719   1719    *	    Truncate.  Set objPtr->length to numBytes and
  1720   1720    *	    objPr->bytes[numBytes] to NUL.  Caller has to guarantee
  1721   1721    *	    that a prior allocating call allocated enough bytes for
  1722   1722    *	    this to be valid. Return objPtr->bytes.
  1723   1723    *
  1724   1724    *	Caller is expected to ascertain that the bytes copied into
  1725   1725    *	the string rep make up complete valid UTF-8 characters.

Changes to generic/tclParse.c.

    15     15   
    16     16   #include "tclInt.h"
    17     17   #include "tclParse.h"
    18     18   #include <assert.h>
    19     19   
    20     20   /*
    21     21    * The following table provides parsing information about each possible 8-bit
    22         - * character. The table is designed to be referenced with either signed or
    23         - * unsigned characters, so it has 384 entries. The first 128 entries
    24         - * correspond to negative character values, the next 256 correspond to
    25         - * positive character values. The last 128 entries are identical to the first
    26         - * 128. The table is always indexed with a 128-byte offset (the 128th entry
    27         - * corresponds to a character value of 0).
           22  + * character. The table is designed to be referenced with unsigned characters.
    28     23    *
    29     24    * The macro CHAR_TYPE is used to index into the table and return information
    30     25    * about its character argument. The following return values are defined.
    31     26    *
    32     27    * TYPE_NORMAL -	All characters that don't have special significance to
    33     28    *			the Tcl parser.
    34     29    * TYPE_SPACE -		The character is a whitespace character other than
................................................................................
    40     35    * TYPE_QUOTE -		Character is a double quote.
    41     36    * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
    42     37    * TYPE_CLOSE_BRACK -	Character is a right square bracket.
    43     38    * TYPE_BRACE -		Character is a curly brace (either left or right).
    44     39    */
    45     40   
    46     41   const char tclCharTypeTable[] = {
    47         -    /*
    48         -     * Negative character values, from -128 to -1:
    49         -     */
    50         -
    51         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    52         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    53         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    54         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    55         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    56         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    57         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    58         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    59         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    60         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    61         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    62         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    63         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    64         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    65         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    66         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    67         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    68         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    69         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    70         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    71         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    72         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    73         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    74         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    75         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    76         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    77         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    78         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    79         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    80         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    81         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    82         -    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    83     42   
    84     43       /*
    85     44        * Positive character values, from 0-127:
    86     45        */
    87     46   
    88     47       TYPE_SUBS,        TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    89     48       TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
................................................................................
  1068   1027    *	None.
  1069   1028    *
  1070   1029    *----------------------------------------------------------------------
  1071   1030    */
  1072   1031   
  1073   1032   int
  1074   1033   TclIsSpaceProc(
  1075         -    char byte)
         1034  +    int byte)
  1076   1035   {
  1077   1036       return CHAR_TYPE(byte) & (TYPE_SPACE) || byte == '\n';
  1078   1037   }
  1079   1038   
  1080   1039   /*
  1081   1040    *----------------------------------------------------------------------
  1082   1041    *
................................................................................
  1097   1056    *	None.
  1098   1057    *
  1099   1058    *----------------------------------------------------------------------
  1100   1059    */
  1101   1060   
  1102   1061   int
  1103   1062   TclIsBareword(
  1104         -    char byte)
         1063  +    int byte)
  1105   1064   {
  1106   1065       if (byte < '0' || byte > 'z') {
  1107   1066   	return 0;
  1108   1067       }
  1109   1068       if (byte <= '9' || byte >= 'a') {
  1110   1069   	return 1;
  1111   1070       }

Changes to generic/tclParse.h.

     8      8   #define TYPE_COMMAND_END	0x2
     9      9   #define TYPE_SUBS		0x4
    10     10   #define TYPE_QUOTE		0x8
    11     11   #define TYPE_CLOSE_PAREN	0x10
    12     12   #define TYPE_CLOSE_BRACK	0x20
    13     13   #define TYPE_BRACE		0x40
    14     14   
    15         -#define CHAR_TYPE(c) (tclCharTypeTable+128)[(int)(c)]
           15  +#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
    16     16   
    17     17   MODULE_SCOPE const char tclCharTypeTable[];

Changes to generic/tclTest.c.

  5027   5027       objPtr->internalRep.twoPtrValue.ptr1 = NULL;
  5028   5028       objPtr->internalRep.twoPtrValue.ptr2 = NULL;
  5029   5029       */
  5030   5030       memset(&objPtr->internalRep, 0, sizeof(objPtr->internalRep));
  5031   5031       if (objc == 2) {
  5032   5032   	const char *s = Tcl_GetString(objv[1]);
  5033   5033   	objPtr->length = objv[1]->length;
  5034         -	objPtr->bytes = ckalloc(objPtr->length + 1);
         5034  +	objPtr->bytes = Tcl_Alloc(objPtr->length + 1);
  5035   5035   	memcpy(objPtr->bytes, s, objPtr->length);
  5036   5036   	objPtr->bytes[objPtr->length] = 0;
  5037   5037       }
  5038   5038       Tcl_SetObjResult(interp, objPtr);
  5039   5039       return TCL_OK;
  5040   5040   }
  5041   5041   

Changes to library/http/cookiejar.tcl.

   454    454   		}
   455    455   	    }
   456    456   	}
   457    457   	set n [expr {[db total_changes] - $n}]
   458    458   	log info "constructed domain info with %d entries" $n
   459    459       }
   460    460   
   461         -    # This forces the rebuild of the domain data, loading it from 
          461  +    # This forces the rebuild of the domain data, loading it from
   462    462       method forceLoadDomainData {} {
   463    463   	db transaction {
   464    464   	    db eval {
   465    465   		DELETE FROM domains;
   466    466   		DELETE FROM forbiddenSuper;
   467    467   		INSERT OR REPLACE INTO domainCacheMetadata
   468    468   		    (id, retrievalDate, installDate)