Tcl Source Code

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

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

Overview
Comment:Merge 8.6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-branch
Files: files | file ages | folders
SHA3-256: 554702212802bd3a7be34c163fa6b08da9f604a2838f48cf6b95e27f3835e51b
User & Date: jan.nijtmans 2018-10-30 20:42:12
Context
2018-11-01
14:48
Eliminate fallback attempts when broken strtod() routines are detected. This has long been creating ... check-in: eaf2699f09 user: dgp tags: core-8-branch
2018-10-30
20:46
Tray a later version of wine Closed-Leaf check-in: 043b844a58 user: jan.nijtmans tags: travis-8.7-wine
20:43
Merge 8.7 check-in: c501ac4d38 user: jan.nijtmans tags: trunk
20:42
Merge 8.6 check-in: 5547022128 user: jan.nijtmans tags: core-8-branch
20:41
Merge 8.5 check-in: c24ce3ea62 user: jan.nijtmans tags: core-8-6-branch
2018-10-29
19:57
Fix compilation on Visual C++ 6.0, which doesn't have LLONG_MIN/LLONG_MAX check-in: 28c1c59dbb user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to unix/configure.

5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
....
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\[email protected]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
................................................................................
    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi

    if test "$tcl_cv_cc_visibility_hidden" != yes; then :






|







 







|







5727
5728
5729
5730
5731
5732
5733
5734
5735
5736
5737
5738
5739
5740
5741
....
6468
6469
6470
6471
6472
6473
6474
6475
6476
6477
6478
6479
6480
6481
6482
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
	    ;;
	DragonFly-*|FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\[email protected]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
................................................................................
    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then :

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi

    if test "$tcl_cv_cc_visibility_hidden" != yes; then :

Changes to unix/tcl.m4.

1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
....
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
................................................................................

    AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
	AC_DEFINE(MODULE_SCOPE, [extern],






|







 







|







1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
....
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"
	    ;;
	DragonFly-*|FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
................................................................................

    AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
	AC_DEFINE(MODULE_SCOPE, [extern],

Changes to win/tclWinDde.c.

113
114
115
116
117
118
119


















120
121
122
123
124
125
126
....
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
....
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
....
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
static int		MakeDdeConnection(Tcl_Interp *interp,
			    const TCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);




















DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, argIndex;
    int length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const TCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;
................................................................................
	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	int dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString =
		    Tcl_GetByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetString(objv[firstArg + 2]);
	    dataLength = objv[firstArg + 2]->length;
	    dataString = (const TCHAR *)
		    Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
................................................................................
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    Tcl_GetByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetString(objv[firstArg + 3]);
	    length = objv[firstArg + 3]->length;
	    dataString = (BYTE *)
		    Tcl_WinUtfToTChar(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);






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







 







|







 







|






|







 







|







113
114
115
116
117
118
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
....
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
....
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
....
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
static int		MakeDdeConnection(Tcl_Interp *interp,
			    const TCHAR *name, HCONV *ddeConvPtr);
static void		SetDdeError(Tcl_Interp *interp);
static int		DdeObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	"-async", NULL
    };
    static const char *const ddeReqOptions[] = {
	"-binary", NULL
    };

    int index, i, argIndex;
    size_t length;
    int flags = 0, result = TCL_OK, firstArg = 0;
    HSZ ddeService = NULL, ddeTopic = NULL, ddeItem = NULL, ddeCookie = NULL;
    HDDEDATA ddeData = NULL, ddeItemData = NULL, ddeReturn;
    HCONV hConv = NULL;
    const TCHAR *serviceName = NULL, *topicName = NULL;
    const char *string;
    DWORD ddeResult;
................................................................................
	    Tcl_DStringFree(&dsBuf);
	} else {
	    Tcl_ResetResult(interp);
	}
	break;

    case DDE_EXECUTE: {
	size_t dataLength;
	const void *dataString;
	Tcl_DString dsBuf;

	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString =
		    getByteArrayFromObj(objv[firstArg + 2], &dataLength);
	} else {
	    const char *src;

	    src = Tcl_GetString(objv[firstArg + 2]);
	    dataLength = objv[firstArg + 2]->length;
	    dataString = (const TCHAR *)
		    Tcl_WinUtfToTChar(src, dataLength, &dsBuf);
................................................................................
	    Tcl_SetErrorCode(interp, "TCL", "DDE", "NULL", NULL);
	    result = TCL_ERROR;
	    goto cleanup;
	}
	Tcl_DStringInit(&dsBuf);
	if (flags & DDE_FLAG_BINARY) {
	    dataString = (BYTE *)
		    getByteArrayFromObj(objv[firstArg + 3], &length);
	} else {
	    const char *data =
		    Tcl_GetString(objv[firstArg + 3]);
	    length = objv[firstArg + 3]->length;
	    dataString = (BYTE *)
		    Tcl_WinUtfToTChar(data, length, &dsBuf);
	    length = Tcl_DStringLength(&dsBuf) + sizeof(TCHAR);

Changes to win/tclWinFile.c.

526
527
528
529
530
531
532





533
534
535
536
537
538
539
...
642
643
644
645
646
647
648




649
650
651
652
653
654
655
 *	anything went wrong.
 *
 *	In the future we should enhance this to return a path object rather
 *	than a string.
 *
 *--------------------------------------------------------------------
 */






static Tcl_Obj *
WinReadLinkDirectory(
    const TCHAR *linkDirPath)
{
    int attr, len, offset;
    DUMMY_REPARSE_BUFFER dummy;
................................................................................
	return retVal;
    }

  invalidError:
    Tcl_SetErrno(EINVAL);
    return NULL;
}




 
/*
 *--------------------------------------------------------------------
 *
 * NativeReadReparse --
 *
 *	Read the junction/reparse information from a given NTFS directory.






>
>
>
>
>







 







>
>
>
>







526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
 *	anything went wrong.
 *
 *	In the future we should enhance this to return a path object rather
 *	than a string.
 *
 *--------------------------------------------------------------------
 */

#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic push
#pragma GCC diagnostic ignored "-Warray-bounds"
#endif

static Tcl_Obj *
WinReadLinkDirectory(
    const TCHAR *linkDirPath)
{
    int attr, len, offset;
    DUMMY_REPARSE_BUFFER dummy;
................................................................................
	return retVal;
    }

  invalidError:
    Tcl_SetErrno(EINVAL);
    return NULL;
}

#if defined (__clang__) || ((__GNUC__)  && ((__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ > 5))))
#pragma GCC diagnostic pop
#endif
 
/*
 *--------------------------------------------------------------------
 *
 * NativeReadReparse --
 *
 *	Read the junction/reparse information from a given NTFS directory.

Changes to win/tclWinReg.c.

119
120
121
122
123
124
125



















126
127
128
129
130
131
132
....
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
			    const TCHAR * pKeyName, REGSAM mode);
static int		RegistryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);




















DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);

	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	int bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) Tcl_GetByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);







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







 







|





|







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
....
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
			    const TCHAR * pKeyName, REGSAM mode);
static int		RegistryObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
			    Tcl_Obj *typeObj, REGSAM mode);

static unsigned char *
getByteArrayFromObj(
	Tcl_Obj *objPtr,
	size_t *lengthPtr
) {
    int length;

    unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &length);
#if TCL_MAJOR_VERSION > 8
    if (sizeof(TCL_HASH_TYPE) > sizeof(int)) {
	/* 64-bit and TIP #494 situation: */
	 *lengthPtr = *(TCL_HASH_TYPE *) objPtr->internalRep.twoPtrValue.ptr1;
    } else
#endif
	/* 32-bit or without TIP #494 */
    *lengthPtr = (size_t) (unsigned) length;
    return result;
}

DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
	Tcl_DStringSetLength(&buf, Tcl_DStringLength(&buf)+1);

	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, (BYTE *) data, (DWORD) Tcl_DStringLength(&buf) + 1);
	Tcl_DStringFree(&buf);
    } else {
	BYTE *data;
	size_t bytelength;

	/*
	 * Store binary data in the registry.
	 */

	data = (BYTE *) getByteArrayFromObj(dataObj, &bytelength);
	result = RegSetValueEx(key, (TCHAR *) valueName, 0,
		(DWORD) type, data, (DWORD) bytelength);
    }

    Tcl_DStringFree(&nameBuf);
    RegCloseKey(key);