Tcl Source Code

Check-in [594e384786]
Login

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

Overview
Comment:3414754 Fix the PATHFLAGS != 0 intrep normalizing trailing slashes.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 594e384786f3d6cd30f07b565a531aa4e74d90e4
User & Date: dgp 2011-10-31 17:06:31
Context
2011-11-01
14:10
Silence warnings. check-in: af91d8f029 user: dgp tags: core-8-5-branch
2011-10-31
19:16
merge to release check-in: 0488895962 user: dgp tags: core-8-5-11-rc
17:08
3414754 Fix the PATHFLAGS != 0 intrep normalizing trailing slashes. check-in: 0b6c54865b user: dgp tags: trunk
17:06
3414754 Fix the PATHFLAGS != 0 intrep normalizing trailing slashes. check-in: 594e384786 user: dgp tags: core-8-5-branch
17:04
Purge the old, buggy implementation. Closed-Leaf check-in: 96abaae1f9 user: dgp tags: bug-3414754
2011-10-26
17:40
merge backport check-in: 799ae39045 user: dgp tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclFileName.c.

819
820
821
822
823
824
825
826
827
828

829
830
831
832
833
834
835
836
 *
 *---------------------------------------------------------------------------
 */

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    char *joining)
{
    int length, needsSep;

    char *dest, *p, *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */







|


>
|







819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
 *
 *---------------------------------------------------------------------------
 */

void
TclpNativeJoinPath(
    Tcl_Obj *prefix,
    const char *joining)
{
    int length, needsSep;
    const char *p;
    char *dest, *start;

    start = Tcl_GetStringFromObj(prefix, &length);

    /*
     * Remove the ./ from tilde prefixed elements, and drive-letter prefixed
     * elements on Windows, unless it is the first component.
     */

Changes to generic/tclInt.h.

2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);
MODULE_SCOPE void	TclpMasterUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
			    Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,







|







2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
MODULE_SCOPE Tcl_Obj *	TclpObjListVolumes(void);
MODULE_SCOPE void	TclpMasterLock(void);
MODULE_SCOPE void	TclpMasterUnlock(void);
MODULE_SCOPE int	TclpMatchFiles(Tcl_Interp *interp, char *separators,
			    Tcl_DString *dirPtr, char *pattern, char *tail);
MODULE_SCOPE int	TclpObjNormalizePath(Tcl_Interp *interp,
			    Tcl_Obj *pathPtr, int nextCheckpoint);
MODULE_SCOPE void	TclpNativeJoinPath(Tcl_Obj *prefix, const char *joining);
MODULE_SCOPE Tcl_Obj *	TclpNativeSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
MODULE_SCOPE Tcl_PathType TclpGetNativePathType(Tcl_Obj *pathPtr,
			    int *driveNameLengthPtr, Tcl_Obj **driveNameRef);
MODULE_SCOPE int	TclCrossFilesystemCopy(Tcl_Interp *interp,
			    Tcl_Obj *source, Tcl_Obj *target);
MODULE_SCOPE int	TclpMatchInDirectory(Tcl_Interp *interp,
			    Tcl_Obj *resultPtr, Tcl_Obj *pathPtr,

Changes to generic/tclPathObj.c.

1363
1364
1365
1366
1367
1368
1369
1370
1371
1372


1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395

1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    int numBytes;
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);

    bytes = Tcl_GetStringFromObj(copy, &numBytes);

    /*


     * Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
     * Windows special case? Perhaps we should just check if cwd is a root
     * volume. We should never get numBytes == 0 in this code path.
     */

    switch (tclPlatform) {
    case TCL_PLATFORM_UNIX:
	if (bytes[numBytes-1] != '/') {
	    Tcl_AppendToObj(copy, "/", 1);
	}
	break;

    case TCL_PLATFORM_WINDOWS:
	/*
	 * We need the extra 'numBytes != 2', and ':' checks because a volume
	 * relative path doesn't get a '/'. For example 'glob C:*cat*.exe'
	 * will return 'C:cat32.exe'
	 */

	if (bytes[numBytes-1] != '/' && bytes[numBytes-1] != '\\') {
	    if (numBytes!= 2 || bytes[1] != ':') {
		Tcl_AppendToObj(copy, "/", 1);
	    }

	}
	break;
    }

    Tcl_AppendObjToObj(copy, tail);
    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathRelative --







<
<

>
>
|
<
<
<
|
<
<
<
<
<
<
|
<
<
|
<
<
|
|
<
|
|
|
>
|
<
<
<
<







1363
1364
1365
1366
1367
1368
1369


1370
1371
1372
1373



1374






1375


1376


1377
1378

1379
1380
1381
1382
1383




1384
1385
1386
1387
1388
1389
1390
    Tcl_Obj *head,
    Tcl_Obj *tail)
{
    int numBytes;
    const char *bytes;
    Tcl_Obj *copy = Tcl_DuplicateObj(head);



    /*
     * This is likely buggy when dealing with virtual filesystem drivers
     * that use some character other than "/" as a path separator.  I know
     * of no evidence that such a foolish thing exists.  This solution was



     * chosen so that "JoinPath" operations that pass through either path






     * intrep produce the same results; that is, bugward compatibility.  If


     * we need to fix that bug here, it needs fixing in Tcl_FSJoinPath() too.


     */
    bytes = Tcl_GetStringFromObj(tail, &numBytes);

    if (numBytes == 0) {
	Tcl_AppendToObj(copy, "/", 1);
    } else {
	TclpNativeJoinPath(copy, bytes);
    }




    return copy;
}

/*
 *---------------------------------------------------------------------------
 *
 * TclFSMakePathRelative --

Changes to tests/fileSystem.test.

1089
1090
1091
1092
1093
1094
1095




1096
1097
1098
1099
1100
1101
    lappend res [catch {file exists $file2} r] $r
    lappend res [string equal $file1 $file2]
    cd ..
    file delete -force tilde
    cd $origdir
    set res
} {0 0 0 0 1}





cleanupTests
unset -nocomplain drive
}
namespace delete ::tcl::test::fileSystem
return







>
>
>
>






1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
    lappend res [catch {file exists $file2} r] $r
    lappend res [string equal $file1 $file2]
    cd ..
    file delete -force tilde
    cd $origdir
    set res
} {0 0 0 0 1}

test filesystem-10.1 {Bug 3414754} {
    string match */ [file join [pwd] foo/]
} 0

cleanupTests
unset -nocomplain drive
}
namespace delete ::tcl::test::fileSystem
return