Tcl Source Code

Check-in [2e12143e39]
Login

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

Overview
Comment:
* generic/tclUtil.c (TclDStringToObj): Added internal function to make the fairly-common operation of converting a DString into an Obj a more efficient one.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 2e12143e3906901f7fe95b8ce11211f9310e741f
User & Date: dkf 2012-04-25 12:07:45
Context
2012-04-26
10:45
fix OSX crash check-in: 8b54a29ab2 user: jan.nijtmans tags: trunk
2012-04-25
21:02
merge trunk check-in: e9150d1e4c user: dgp tags: dgp-remove-string-result
12:07
* generic/tclUtil.c (TclDStringToObj): Added internal function to make the fairly-common operation...
check-in: 2e12143e39 user: dkf tags: trunk
2012-04-24
21:50
fix merge error check-in: ca02a64d68 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.












1
2
3
4
5
6
7











2012-04-24  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3508771] load tclreg.dll in cygwin tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, TclWinGetServByName
	* generic/tclStubInit.c:     and TclWinCPUID for Cygwin
	* generic/tclUnixCompat.c:
	* unix/configure.in:
>
>
>
>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
2012-04-25  Donal K. Fellows  <[email protected]>

	* generic/tclUtil.c (TclDStringToObj): Added internal function to make
	the fairly-common operation of converting a DString into an Obj a more
	efficient one; for long strings, it can just transfer the ownership of
	the buffer directly. Replaces this:
	   obj=Tcl_NewStringObj(Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
	   Tcl_DStringFree(&ds);
	with this:
	   obj=TclDStringToObj(&ds);

2012-04-24  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3508771] load tclreg.dll in cygwin tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetSockOpt, TclWinGetServByName
	* generic/tclStubInit.c:     and TclWinCPUID for Cygwin
	* generic/tclUnixCompat.c:
	* unix/configure.in:

Changes to generic/tclCmdAH.c.

559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);

	    /*
	     * Note that we cannot use Tcl_DStringResult here because it will
	     * truncate the string at the first null byte.
	     */

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)));
	    Tcl_DStringFree(&ds);
	} else {
	    /*
	     * Store the result as binary data.
	     */

	    stringPtr = TclGetStringFromObj(data, &length);
	    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);







|
<
<







559
560
561
562
563
564
565
566


567
568
569
570
571
572
573
	    Tcl_ExternalToUtfDString(encoding, stringPtr, length, &ds);

	    /*
	     * Note that we cannot use Tcl_DStringResult here because it will
	     * truncate the string at the first null byte.
	     */

	    Tcl_SetObjResult(interp, TclDStringToObj(&ds));


	} else {
	    /*
	     * Store the result as binary data.
	     */

	    stringPtr = TclGetStringFromObj(data, &length);
	    Tcl_UtfToExternalDString(encoding, stringPtr, length, &ds);
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
static int
PathNativeNameCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    const char *fileName;
    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    fileName = Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds);
    if (fileName == NULL) {
	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj(fileName,
	    Tcl_DStringLength(&ds)));
    Tcl_DStringFree(&ds);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --







<






|
<


|
<
<







1863
1864
1865
1866
1867
1868
1869

1870
1871
1872
1873
1874
1875
1876

1877
1878
1879


1880
1881
1882
1883
1884
1885
1886
static int
PathNativeNameCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    Tcl_DString ds;

    if (objc != 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "name");
	return TCL_ERROR;
    }
    if (Tcl_TranslateFileName(interp, TclGetString(objv[1]), &ds) == NULL) {

	return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, TclDStringToObj(&ds));


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * PathNormalizeCmd --

Changes to generic/tclFileName.c.

441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
	    const char *rootEnd;

	    Tcl_DStringInit(&ds);
	    rootEnd = ExtractWinRoot(path, &ds, 0, &type);
	    if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
		*driveNameLengthPtr = rootEnd - path;
		if (driveNameRef != NULL) {
		    *driveNameRef = Tcl_NewStringObj(Tcl_DStringValue(&ds),
			    Tcl_DStringLength(&ds));
		    Tcl_IncrRefCount(*driveNameRef);
		}
	    }
	    Tcl_DStringFree(&ds);
	    break;
	}
	}







|
<







441
442
443
444
445
446
447
448

449
450
451
452
453
454
455
	    const char *rootEnd;

	    Tcl_DStringInit(&ds);
	    rootEnd = ExtractWinRoot(path, &ds, 0, &type);
	    if ((rootEnd != path) && (driveNameLengthPtr != NULL)) {
		*driveNameLengthPtr = rootEnd - path;
		if (driveNameRef != NULL) {
		    *driveNameRef = TclDStringToObj(&ds);

		    Tcl_IncrRefCount(*driveNameRef);
		}
	    }
	    Tcl_DStringFree(&ds);
	    break;
	}
	}
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(
		Tcl_DStringValue(&buf), Tcl_DStringLength(&buf)));
    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes. Embedded elements that start with tilde or a drive
     * letter will be prefixed with "./" so they are not affected by tilde
     * substitution.







|
<







719
720
721
722
723
724
725
726

727
728
729
730
731
732
733
    p = ExtractWinRoot(path, &buf, 0, &type);

    /*
     * Terminate the root portion, if we matched something.
     */

    if (p != path) {
	Tcl_ListObjAppendElement(NULL, result, TclDStringToObj(&buf));

    }
    Tcl_DStringFree(&buf);

    /*
     * Split on slashes. Embedded elements that start with tilde or a drive
     * letter will be prefixed with "./" so they are not affected by tilde
     * substitution.
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
	    *tail = c;
	    if (head == NULL) {
		return TCL_ERROR;
	    }
	    if (head != Tcl_DStringValue(&buffer)) {
		Tcl_DStringAppend(&buffer, head, -1);
	    }
	    pathPrefix = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
		    Tcl_DStringLength(&buffer));
	    Tcl_IncrRefCount(pathPrefix);
	    globFlags |= TCL_GLOBMODE_DIR;
	    if (c != '\0') {
		tail++;
	    }
	    Tcl_DStringFree(&buffer);
	} else {
	    tail = pattern;
	}
    } else {
	Tcl_IncrRefCount(pathPrefix);
	tail = pattern;
    }







|
<





<







1745
1746
1747
1748
1749
1750
1751
1752

1753
1754
1755
1756
1757

1758
1759
1760
1761
1762
1763
1764
	    *tail = c;
	    if (head == NULL) {
		return TCL_ERROR;
	    }
	    if (head != Tcl_DStringValue(&buffer)) {
		Tcl_DStringAppend(&buffer, head, -1);
	    }
	    pathPrefix = TclDStringToObj(&buffer);

	    Tcl_IncrRefCount(pathPrefix);
	    globFlags |= TCL_GLOBMODE_DIR;
	    if (c != '\0') {
		tail++;
	    }

	} else {
	    tail = pattern;
	}
    } else {
	Tcl_IncrRefCount(pathPrefix);
	tail = pattern;
    }
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = Tcl_NewStringObj(Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*







|
<







2415
2416
2417
2418
2419
2420
2421
2422

2423
2424
2425
2426
2427
2428
2429
	}

	/*
	 * Common for all platforms.
	 */

	if (pathPtr == NULL) {
	    joinedPtr = TclDStringToObj(&append);

	} else if (flags) {
	    joinedPtr = TclNewFSPathObj(pathPtr, Tcl_DStringValue(&append),
		    Tcl_DStringLength(&append));
	} else {
	    joinedPtr = Tcl_DuplicateObj(pathPtr);
	    if (strchr(separators, Tcl_DStringValue(&append)[0]) == NULL) {
		/*

Changes to generic/tclInt.h.

2916
2917
2918
2919
2920
2921
2922

2923
2924
2925
2926
2927
2928
2929
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);

MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);







>







2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
MODULE_SCOPE Tcl_ObjCmdProc TclFileReadLinkCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileRenameCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclFileTemporaryCmd;
MODULE_SCOPE void	TclCreateLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE void	TclDeleteLateExitHandler(Tcl_ExitProc *proc,
			    ClientData clientData);
MODULE_SCOPE Tcl_Obj *	TclDStringToObj(Tcl_DString *dsPtr);
MODULE_SCOPE void	TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void	TclFinalizeAsync(void);
MODULE_SCOPE void	TclFinalizeDoubleConversion(void);
MODULE_SCOPE void	TclFinalizeEncodingSubsystem(void);
MODULE_SCOPE void	TclFinalizeEnvironment(void);
MODULE_SCOPE void	TclFinalizeEvaluation(void);
MODULE_SCOPE void	TclFinalizeExecution(void);

Changes to generic/tclMain.c.

49
50
51
52
53
54
55
56
57
58
59

60
61
62

63
64


65

66
67
68
69
70
71
72
73
74
75
76
#ifndef __WIN32__
#   define TCHAR char
#   define TEXT(arg) arg
#   define _tcscmp strcmp
#endif

/*
 * Further on, in UNICODE mode, we need to use Tcl_NewUnicodeObj,
 * while otherwise NewNativeObj is needed (which provides proper
 * conversion from native encoding to UTF-8).
 */

#ifdef UNICODE
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE */

    static Tcl_Obj *NewNativeObj(char *string, int length) {
	Tcl_Obj *obj;


	Tcl_DString ds;

	Tcl_ExternalToUtfDString(NULL, string, length, &ds);
	obj = Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	return obj;
}
#endif /* !UNICODE */

/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).







|
|
|

>



>
|
|
>
>
|
>
|
<
<
|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71


72
73
74
75
76
77
78
79
#ifndef __WIN32__
#   define TCHAR char
#   define TEXT(arg) arg
#   define _tcscmp strcmp
#endif

/*
 * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
 * NewNativeObj is needed (which provides proper conversion from native
 * encoding to UTF-8).
 */

#ifdef UNICODE
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE */
static inline Tcl_Obj *
NewNativeObj(
    char *string,
    int length)
{
    Tcl_DString ds;

    Tcl_ExternalToUtfDString(NULL, string, length, &ds);


    return TclDStringToObj(&ds);
}
#endif /* !UNICODE */

/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).

Changes to generic/tclPathObj.c.

2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {
	char *expandedUser;
	Tcl_DString temp;
	int split;
	char separator = '/';

	split = FindSplitPos(name, separator);
	if (split != len) {
	    /*







<







2369
2370
2371
2372
2373
2374
2375

2376
2377
2378
2379
2380
2381
2382
    name = Tcl_GetStringFromObj(pathPtr, &len);

    /*
     * Handle tilde substitutions, if needed.
     */

    if (name[0] == '~') {

	Tcl_DString temp;
	int split;
	char separator = '/';

	split = FindSplitPos(name, separator);
	if (split != len) {
	    /*
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
		return TCL_ERROR;
	    }
	    if (split != len) {
		name[split] = separator;
	    }
	}

	expandedUser = Tcl_DStringValue(&temp);
	transPtr = Tcl_NewStringObj(expandedUser, Tcl_DStringLength(&temp));

	if (split != len) {
	    /*
	     * Join up the tilde substitution with the rest.
	     */

	    if (name[split+1] == separator) {







<
|







2437
2438
2439
2440
2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
2451
		return TCL_ERROR;
	    }
	    if (split != len) {
		name[split] = separator;
	    }
	}


	transPtr = TclDStringToObj(&temp);

	if (split != len) {
	    /*
	     * Join up the tilde substitution with the rest.
	     */

	    if (name[split+1] == separator) {
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498

		Tcl_IncrRefCount(transPtr);
		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
		TclDecrRefCount(transPtr);
		transPtr = joined;
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr);
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.







<







2482
2483
2484
2485
2486
2487
2488

2489
2490
2491
2492
2493
2494
2495

		Tcl_IncrRefCount(transPtr);
		joined = Tcl_FSJoinToPath(transPtr, 1, &rest);
		TclDecrRefCount(transPtr);
		transPtr = joined;
	    }
	}

    } else {
	transPtr = TclJoinPath(1, &pathPtr);
    }

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.

Changes to generic/tclRegexp.c.

943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
    /*
     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
	regexpPtr->globObjPtr = Tcl_NewStringObj(Tcl_DStringValue(&stringBuf),
		Tcl_DStringLength(&stringBuf));
	Tcl_IncrRefCount(regexpPtr->globObjPtr);
	Tcl_DStringFree(&stringBuf);
    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.







|
<

<







943
944
945
946
947
948
949
950

951

952
953
954
955
956
957
958
    /*
     * Convert RE to a glob pattern equivalent, if any, and cache it.  If this
     * is not possible, then globObjPtr will be NULL.  This is used by
     * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
     */

    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);

	Tcl_IncrRefCount(regexpPtr->globObjPtr);

    } else {
	regexpPtr->globObjPtr = NULL;
    }

    /*
     * Allocate enough space for all of the subexpressions, plus one extra for
     * the entire pattern.

Changes to generic/tclUtil.c.

2707
2708
2709
2710
2711
2712
2713


























































2714
2715
2716
2717
2718
2719
2720
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
}



























































/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringStartSublist --
 *
 *	This function adds the necessary information to a dynamic string







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







2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
	}
	memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
    }

    iPtr->result = iPtr->resultSpace;
    iPtr->resultSpace[0] = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclDStringToObj --
 *
 *	This function moves a dynamic string's contents to a new Tcl_Obj. Be
 *	aware that this function does *not* check that the encoding of the
 *	contents of the dynamic string is correct; this is the caller's
 *	responsibility to enforce.
 *
 * Results:
 *	The newly-allocated untyped (i.e., typePtr==NULL) Tcl_Obj with a
 *	reference count of zero.
 *
 * Side effects:
 *	The string is "moved" to the object. dsPtr is reinitialized to an
 *	empty string; it does not need to be Tcl_DStringFree'd after this if
 *	not used further.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclDStringToObj(
    Tcl_DString *dsPtr)
{
    Tcl_Obj *result;

    if (dsPtr->length == 0) {
	TclNewObj(result);
    } else if (dsPtr->string == dsPtr->staticSpace) {
	/*
	 * Static buffer, so must copy.
	 */

	TclNewStringObj(result, dsPtr->string, dsPtr->length);
    } else {
	/*
	 * Dynamic buffer, so transfer ownership and reset.
	 */

	TclNewObj(result);
	result->bytes = dsPtr->string;
	result->length = dsPtr->length;
    }

    /*
     * Re-establish the DString as empty with no buffer allocated.
     */

    dsPtr->string = dsPtr->staticSpace;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->length = 0;
    dsPtr->staticSpace[0] = '\0';

    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringStartSublist --
 *
 *	This function adds the necessary information to a dynamic string

Changes to generic/tclZlib.c.

395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
		&tmp);
	SetValue(dictObj, "comment", Tcl_NewStringObj(Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp)));
	Tcl_DStringFree(&tmp);
    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
		&tmp);
	SetValue(dictObj, "filename", Tcl_NewStringObj(Tcl_DStringValue(&tmp),
		Tcl_DStringLength(&tmp)));
	Tcl_DStringFree(&tmp);
    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
    }







|
<
<
















|
<
<







395
396
397
398
399
400
401
402


403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419


420
421
422
423
424
425
426
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, -1,
		&tmp);
	SetValue(dictObj, "comment", TclDStringToObj(&tmp));


    }
    SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc));
    if (headerPtr->name != Z_NULL) {
	if (latin1enc == NULL) {
	    /*
	     * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1).
	     */

	    latin1enc = Tcl_GetEncoding(NULL, "iso8859-1");
	    if (latin1enc == NULL) {
		Tcl_Panic("no latin-1 encoding");
	    }
	}

	Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, -1,
		&tmp);
	SetValue(dictObj, "filename", TclDStringToObj(&tmp));


    }
    if (headerPtr->os != 255) {
	SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
    }
    if (headerPtr->time != 0 /* magic - no time */) {
	SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
    }

Changes to unix/tclUnixFCmd.c.

1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
    } else {
	Tcl_DString ds;
	const char *utf;

	utf = Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = Tcl_NewStringObj(utf, Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







<

|
|
<







1383
1384
1385
1386
1387
1388
1389

1390
1391
1392

1393
1394
1395
1396
1397
1398
1399

    pwPtr = TclpGetPwUid(statBuf.st_uid);

    if (pwPtr == NULL) {
	*attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
    } else {
	Tcl_DString ds;


	(void) Tcl_ExternalToUtfDString(NULL, pwPtr->pw_name, -1, &ds);
	*attributePtrPtr = TclDStringToObj(&ds);

    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

Changes to unix/tclUnixFile.c.

998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017

	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
	linkPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	if (linkPtr != NULL) {
	    Tcl_IncrRefCount(linkPtr);
	}
	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*
 *---------------------------------------------------------------------------







|
<
<
<
|
<







998
999
1000
1001
1002
1003
1004
1005



1006

1007
1008
1009
1010
1011
1012
1013

	length = readlink(Tcl_FSGetNativePath(pathPtr), link, sizeof(link));
	if (length < 0) {
	    return NULL;
	}

	Tcl_ExternalToUtfDString(NULL, link, length, &ds);
	linkPtr = TclDStringToObj(&ds);



	Tcl_IncrRefCount(linkPtr);

	return linkPtr;
    }
}
#endif /* S_IFLNK */

/*
 *---------------------------------------------------------------------------
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
 */

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;
    Tcl_Obj *objPtr;
    int len;

    const char *copy;
    Tcl_ExternalToUtfDString(NULL, (const char*)clientData, -1, &ds);

    copy = Tcl_DStringValue(&ds);
    len = Tcl_DStringLength(&ds);

    objPtr = Tcl_NewStringObj(copy,len);
    Tcl_DStringFree(&ds);

    return objPtr;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *







<
<

<
|
|
<
<
<
<
<
<
<







1061
1062
1063
1064
1065
1066
1067


1068

1069
1070







1071
1072
1073
1074
1075
1076
1077
 */

Tcl_Obj *
TclpNativeToNormalized(
    ClientData clientData)
{
    Tcl_DString ds;




    Tcl_ExternalToUtfDString(NULL, (const char *) clientData, -1, &ds);
    return TclDStringToObj(&ds);







}

/*
 *---------------------------------------------------------------------------
 *
 * TclNativeCreateNativeRep --
 *

Changes to unix/tclUnixInit.c.

450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481

	sprintf(installLib, "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */

	objPtr = Tcl_NewStringObj(str, -1);
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
	    Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	    Tcl_DStringFree(&ds);
	}
	ckfree(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different







<
|













<
|
<







450
451
452
453
454
455
456

457
458
459
460
461
462
463
464
465
466
467
468
469
470

471

472
473
474
475
476
477
478

	sprintf(installLib, "lib/tcl%s", TCL_VERSION);

	/*
	 * If TCL_LIBRARY is set, search there.
	 */


	Tcl_ListObjAppendElement(NULL, pathPtr, Tcl_NewStringObj(str, -1));

	Tcl_SplitPath(str, &pathc, &pathv);
	if ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc-1]) != 0)) {
	    /*
	     * If TCL_LIBRARY is set but refers to a different tcl
	     * installation than the current version, try fiddling with the
	     * specified directory to make it refer to this installation by
	     * removing the old "tclX.Y" and substituting the current version
	     * string.
	     */

	    pathv[pathc - 1] = installLib + 4;
	    str = Tcl_JoinPath(pathc, pathv, &ds);

	    Tcl_ListObjAppendElement(NULL, pathPtr, TclDStringToObj(&ds));

	}
	ckfree(pathv);
    }

    /*
     * Finally, look for the library relative to the compiled-in path. This is
     * needed when users install Tcl with an exec-prefix that is different

Changes to win/tclWinFCmd.c.

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	int len = Tcl_DStringLength(&ds);
	if (len > 0) {
	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;







|
<




|







1007
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
	ret = DoRemoveDirectory(&native, recursive, &ds);
	Tcl_DStringFree(&native);
    } else {
	ret = DoRemoveJustDirectory(Tcl_FSGetNativePath(pathPtr), 0, &ds);
    }

    if (ret != TCL_OK) {
	if (Tcl_DStringLength(&ds) > 0) {

	    if (normPtr != NULL &&
		    !strcmp(Tcl_DStringValue(&ds), TclGetString(normPtr))) {
		*errorPtr = pathPtr;
	    } else {
		*errorPtr = TclDStringToObj(&ds);
	    }
	    Tcl_IncrRefCount(*errorPtr);
	}
	Tcl_DStringFree(&ds);
    }

    return ret;
1758
1759
1760
1761
1762
1763
1764

1765
1766
1767
1768
1769
1770
1771
1772
1773

1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
	     *
	     *	fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);


	    /*
	     * Deal with issues of tildes being absolute.
	     */

	    if (Tcl_DStringValue(&dsTemp)[0] == '~') {
		TclNewLiteralStringObj(tempPath, "./");
		Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
			Tcl_DStringLength(&dsTemp));

	    } else {
		tempPath = Tcl_NewStringObj(Tcl_DStringValue(&dsTemp),
			Tcl_DStringLength(&dsTemp));
	    }
	    Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);
	    Tcl_DStringFree(&ds);
	    Tcl_DStringFree(&dsTemp);
	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

    if (splitPath != NULL) {







>









>

|
<


<
<







1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776

1777
1778


1779
1780
1781
1782
1783
1784
1785
	     *
	     *	fprintf(stderr, "%d\n", data.w.cAlternateFileName[0]);
	     *	fprintf(stderr, "%d\n", ((WCHAR *) nativeName)[0]);
	     */

	    Tcl_DStringInit(&dsTemp);
	    Tcl_WinTCharToUtf(nativeName, -1, &dsTemp);
	    Tcl_DStringFree(&ds);

	    /*
	     * Deal with issues of tildes being absolute.
	     */

	    if (Tcl_DStringValue(&dsTemp)[0] == '~') {
		TclNewLiteralStringObj(tempPath, "./");
		Tcl_AppendToObj(tempPath, Tcl_DStringValue(&dsTemp),
			Tcl_DStringLength(&dsTemp));
		Tcl_DStringFree(&dsTemp);
	    } else {
		tempPath = TclDStringToObj(&dsTemp);

	    }
	    Tcl_ListObjReplace(NULL, splitPath, i, 1, 1, &tempPath);


	    FindClose(handle);
	}
    }

    *attributePtrPtr = Tcl_FSJoinPath(splitPath, -1);

    if (splitPath != NULL) {

Changes to win/tclWinFile.c.

2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
	Tcl_DecrRefCount(driveName);
    }

    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;
	Tcl_Obj *objPtr;

	Tcl_WinTCharToUtf(volType, -1, &ds);
	objPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		Tcl_DStringLength(&ds));
	Tcl_DStringFree(&ds);
	return objPtr;
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new







<


<
<
<
|







2346
2347
2348
2349
2350
2351
2352

2353
2354



2355
2356
2357
2358
2359
2360
2361
2362
	Tcl_DecrRefCount(driveName);
    }

    if (found == 0) {
	return NULL;
    } else {
	Tcl_DString ds;


	Tcl_WinTCharToUtf(volType, -1, &ds);



	return TclDStringToObj(&ds);
    }
#undef VOL_BUF_SIZE
}

/*
 * This define can be turned on to experiment with a different way of
 * normalizing paths (using a different Windows API). Unfortunately the new

Changes to win/tclWinInit.c.

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
	     * than the current version. Try fiddling with the specified
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    str = Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = Tcl_NewStringObj(str, Tcl_DStringLength(&ds));
	    Tcl_DStringFree(&ds);
	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	ckfree(pathv);
    }
}







|
|
<







295
296
297
298
299
300
301
302
303

304
305
306
307
308
309
310
	     * than the current version. Try fiddling with the specified
	     * directory to make it refer to this installation by removing the
	     * old "tclX.Y" and substituting the current version string.
	     */

	    pathv[pathc - 1] = shortlib;
	    Tcl_DStringInit(&ds);
	    (void) Tcl_JoinPath(pathc, pathv, &ds);
	    objPtr = TclDStringToObj(&ds);

	} else {
	    objPtr = Tcl_NewStringObj(buf, -1);
	}
	Tcl_ListObjAppendElement(NULL, pathPtr, objPtr);
	ckfree(pathv);
    }
}