Tcl Source Code

Check-in [575001f433]
Login

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

Overview
Comment:3024359 Make sure that the per-thread cache of the list of file systems currently registered is only updated at times when no active loops are traversing it. Also reduce the amount of epoch storing and checking to where it can make a difference.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-5-branch
Files: files | file ages | folders
SHA1: 575001f433a0cee3d1a8a080f017929b94f03905
User & Date: dgp 2012-06-25 15:19:52
Context
2012-06-25
16:19
Repair Claim/Disclaim imbalance check-in: 42530a7e20 user: dgp tags: core-8-5-branch
15:19
3024359 Make sure that the per-thread cache of the list of file systems currently registered is only... check-in: 575001f433 user: dgp tags: core-8-5-branch
14:43
Simplify bug fix so that active claims on the FilesystemRecord list of a thread prevent any overwrit... Closed-Leaf check-in: 37c6c2a2fc user: dgp tags: bug-3024359
12:54
[Bug 3537605]: Make [encoding dirs ? ?] report the right error message. check-in: 59d8363bd7 user: dkf tags: core-8-5-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.









1
2
3
4
5
6
7








2012-06-25  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
	thing when reporting errors with the number of arguments.

2012-06-25  Jan Nijtmans  <[email protected]>

>
>
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
2012-06-25  Don Porter  <[email protected]>

	* generic/tclFileSystem.h:	[Bug 3024359] Make sure that the
	* generic/tclIOUtil.c:	per-thread cache of the list of file systems
	* generic/tclPathObj.c:	currently registered is only updated at times
	when no active loops are traversing it.  Also reduce the amount of
	epoch storing and checking to where it can make a difference.

2012-06-25  Donal K. Fellows  <[email protected]>

	* generic/tclCmdAH.c (EncodingDirsObjCmd): [Bug 3537605]: Do the right
	thing when reporting errors with the number of arguments.

2012-06-25  Jan Nijtmans  <[email protected]>

Changes to generic/tclFileSystem.h.

47
48
49
50
51
52
53

54
55
56
57
58
59
60
typedef struct ThreadSpecificData {
    int initialized;
    int cwdPathEpoch;
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;

} ThreadSpecificData;

/*
 * The internal TclFS API provides routines for handling and manipulating
 * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
 *
 * These functions are not exported at all at present.







>







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
typedef struct ThreadSpecificData {
    int initialized;
    int cwdPathEpoch;
    int filesystemEpoch;
    Tcl_Obj *cwdPathPtr;
    ClientData cwdClientData;
    FilesystemRecord *filesystemList;
    int claims;
} ThreadSpecificData;

/*
 * The internal TclFS API provides routines for handling and manipulating
 * paths efficiently, taking direct advantage of the "path" Tcl_Obj type.
 *
 * These functions are not exported at all at present.

Changes to generic/tclIOUtil.c.

35
36
37
38
39
40
41
42
43


44
45
46
47
48
49
50
51
static void		FsThrExitProc(ClientData cd);
static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);

#ifdef TCL_THREADS
static void		FsRecacheFilesystemList(void);


#endif

/*
 * These form part of the native filesystem support. They are needed here
 * because we have a few native filesystem functions (which are the same for
 * win/unix) in this file. There is no need to place them in tclInt.h, because
 * they are not (and should not be) used anywhere else.
 */







<

>
>
|







35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
static void		FsThrExitProc(ClientData cd);
static Tcl_Obj *	FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
static void		FsAddMountsToGlobResult(Tcl_Obj *resultPtr,
			    Tcl_Obj *pathPtr, const char *pattern,
			    Tcl_GlobTypeData *types);
static void		FsUpdateCwd(Tcl_Obj *cwdObj, ClientData clientData);


static void		FsRecacheFilesystemList(void);
static void		Claim(void);
static void		Disclaim(void);


/*
 * These form part of the native filesystem support. They are needed here
 * because we have a few native filesystem functions (which are the same for
 * win/unix) in this file. There is no need to place them in tclInt.h, because
 * they are not (and should not be) used anywhere else.
 */
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
/*
 * This is incremented each time we modify the linked list of filesystems. Any
 * time it changes, all cached filesystem representations are suspect and must
 * be freed. For multithreading builds, change of the filesystem epoch will
 * trigger cache cleanup in all threads.
 */

static int theFilesystemEpoch = 0;

/*
 * Stores the linked list of filesystems. A 1:1 copy of this list is also
 * maintained in the TSD for each thread. This is to avoid synchronization
 * issues.
 */








|







406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
/*
 * This is incremented each time we modify the linked list of filesystems. Any
 * time it changes, all cached filesystem representations are suspect and must
 * be freed. For multithreading builds, change of the filesystem epoch will
 * trigger cache cleanup in all threads.
 */

static int theFilesystemEpoch = 1;

/*
 * Stores the linked list of filesystems. A 1:1 copy of this list is also
 * maintained in the TSD for each thread. This is to avoid synchronization
 * issues.
 */

577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611

612
613
614
615
616
617
618
619
620
621

622
623
624
625
626
627
628
629
630
631
632
633



634
635
636

637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681






682


683




684
685
686
687
688
689
690
691
	    return 1;
	} else {
	    return 0;
	}
    }
}

#ifdef TCL_THREADS
static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;
	fsRecPtr->fsPtr = NULL;
	fsRecPtr->nextPtr = toFree;
	toFree = fsRecPtr;
	fsRecPtr = tmpFsRecPtr;
    }
    tsdPtr->filesystemList = NULL;

    /*
     * Code below operates on shared data. We are already called under mutex
     * lock so we can safely proceed.
     *
     * Locate tail of the global filesystem list.
     */


    fsRecPtr = filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr;
	fsRecPtr = fsRecPtr->nextPtr;
    }

    /*
     * Refill the cache honouring the order.
     */


    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = tsdPtr->filesystemList;
	tmpFsRecPtr->prevPtr = NULL;
	if (tsdPtr->filesystemList) {
	    tsdPtr->filesystemList->prevPtr = tmpFsRecPtr;
	}
	tsdPtr->filesystemList = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }




    while (toFree) {
	FilesystemRecord *next = toFree->nextPtr;

	ckfree((char *)toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }
}
#endif /* TCL_THREADS */

static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr;
#ifndef TCL_THREADS
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    fsRecPtr = filesystemList;
#else
    Tcl_MutexLock(&filesystemMutex);
    if (tsdPtr->filesystemList == NULL
	    || (tsdPtr->filesystemEpoch != theFilesystemEpoch)) {
	FsRecacheFilesystemList();
	tsdPtr->filesystemEpoch = theFilesystemEpoch;
    }
    Tcl_MutexUnlock(&filesystemMutex);
    fsRecPtr = tsdPtr->filesystemList;
#endif
    return fsRecPtr;
}

/*
 * The epoch can be changed both by filesystems being added or removed and by
 * env(HOME) changing.
 */

int
TclFSEpochOk(
    int filesystemEpoch)
{






    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);


    (void) FsGetFirstFilesystem();




    return (filesystemEpoch == tsdPtr->filesystemEpoch);
}

/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void







<




|








<




<


<
<
<



>










>




|

<
<
<
|


>
>
>



>













<





<
<
<
<
<
<
|
|

<

<
|
<
<











>
>
>
>
>
>

>
>
|
>
>
>
>
|







578
579
580
581
582
583
584

585
586
587
588
589
590
591
592
593
594
595
596
597

598
599
600
601

602
603



604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624



625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647

648
649
650
651
652






653
654
655

656

657


658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
	    return 1;
	} else {
	    return 0;
	}
    }
}


static void
FsRecacheFilesystemList(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    FilesystemRecord *fsRecPtr, *tmpFsRecPtr = NULL, *toFree = NULL, *list;

    /*
     * Trash the current cache.
     */

    fsRecPtr = tsdPtr->filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr->nextPtr;

	fsRecPtr->nextPtr = toFree;
	toFree = fsRecPtr;
	fsRecPtr = tmpFsRecPtr;
    }


    /*



     * Locate tail of the global filesystem list.
     */

    Tcl_MutexLock(&filesystemMutex);
    fsRecPtr = filesystemList;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = fsRecPtr;
	fsRecPtr = fsRecPtr->nextPtr;
    }

    /*
     * Refill the cache honouring the order.
     */

    list = NULL;
    fsRecPtr = tmpFsRecPtr;
    while (fsRecPtr != NULL) {
	tmpFsRecPtr = (FilesystemRecord *) ckalloc(sizeof(FilesystemRecord));
	*tmpFsRecPtr = *fsRecPtr;
	tmpFsRecPtr->nextPtr = list;
	tmpFsRecPtr->prevPtr = NULL;



	list = tmpFsRecPtr;
	fsRecPtr = fsRecPtr->prevPtr;
    }
    tsdPtr->filesystemList = list;
    tsdPtr->filesystemEpoch = theFilesystemEpoch;
    Tcl_MutexUnlock(&filesystemMutex);

    while (toFree) {
	FilesystemRecord *next = toFree->nextPtr;
	toFree->fsPtr = NULL;
	ckfree((char *)toFree);
	toFree = next;
    }

    /*
     * Make sure the above gets released on thread exit.
     */

    if (tsdPtr->initialized == 0) {
	Tcl_CreateThreadExitHandler(FsThrExitProc, (ClientData) tsdPtr);
	tsdPtr->initialized = 1;
    }
}


static FilesystemRecord *
FsGetFirstFilesystem(void)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);






    if (tsdPtr->filesystemList == NULL || ((tsdPtr->claims == 0)
	    && (tsdPtr->filesystemEpoch != theFilesystemEpoch))) {
	FsRecacheFilesystemList();

    }

    return tsdPtr->filesystemList;


}

/*
 * The epoch can be changed both by filesystems being added or removed and by
 * env(HOME) changing.
 */

int
TclFSEpochOk(
    int filesystemEpoch)
{
    return (filesystemEpoch == 0 || filesystemEpoch == theFilesystemEpoch);
}

static void
Claim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    tsdPtr->claims++;
}

static void
Disclaim()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);
    tsdPtr->claims--;
}

/*
 * If non-NULL, clientData is owned by us and must be freed later.
 */

static void
795
796
797
798
799
800
801

802
803
804
805
806
807
808
	/* The native filesystem is static, so we don't free it. */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }

    filesystemList = NULL;

    /*
     * Now filesystemList is NULL. This means that any attempt to use the
     * filesystem is likely to fail.
     */








>







794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
	/* The native filesystem is static, so we don't free it. */

	if (fsRecPtr != &nativeFilesystemRecord) {
	    ckfree((char *)fsRecPtr);
	}
	fsRecPtr = tmpFsRecPtr;
    }
    theFilesystemEpoch++;
    filesystemList = NULL;

    /*
     * Now filesystemList is NULL. This means that any attempt to use the
     * filesystem is likely to fail.
     */

832
833
834
835
836
837
838

839
840
841
842
843
844
845
 *----------------------------------------------------------------------
 */

void
TclResetFilesystem(void)
{
    filesystemList = &nativeFilesystemRecord;


#ifdef __WIN32__
    /*
     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */








>







832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
 *----------------------------------------------------------------------
 */

void
TclResetFilesystem(void)
{
    filesystemList = &nativeFilesystemRecord;
    theFilesystemEpoch++;

#ifdef __WIN32__
    /*
     * Cleans up the win32 API filesystem proc lookup table. This must happen
     * very late in finalization so that deleting of copied dlls can occur.
     */

1404
1405
1406
1407
1408
1409
1410

1411
1412
1413
1414
1415
1416
1417
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e. '/' on unix is native).
     */

    firstFsRecPtr = FsGetFirstFilesystem();


    fsRecPtr = firstFsRecPtr;
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		startAt = (*proc)(interp, pathPtr, startAt);
	    }







>







1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
     * special case, in which if we have a native filesystem handler, we call
     * it first. This is because the root of Tcl's filesystem is always a
     * native filesystem (i.e. '/' on unix is native).
     */

    firstFsRecPtr = FsGetFirstFilesystem();

    Claim();
    fsRecPtr = firstFsRecPtr;
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr == &tclNativeFilesystem) {
	    Tcl_FSNormalizePathProc *proc = fsRecPtr->fsPtr->normalizePathProc;
	    if (proc != NULL) {
		startAt = (*proc)(interp, pathPtr, startAt);
	    }
1436
1437
1438
1439
1440
1441
1442

1443
1444
1445
1446
1447
1448
1449
	     * We could add an efficiency check like this:
	     *		if (retVal == length-of(pathPtr)) {break;}
	     * but there's not much benefit.
	     */
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }


    return startAt;
}

/*
 *---------------------------------------------------------------------------
 *







>







1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
	     * We could add an efficiency check like this:
	     *		if (retVal == length-of(pathPtr)) {break;}
	     * but there's not much benefit.
	     */
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return startAt;
}

/*
 *---------------------------------------------------------------------------
 *
2630
2631
2632
2633
2634
2635
2636

2637
2638
2639
2640
2641
2642
2643
	/*
	 * We've never been called before, try to find a cwd. Call each of the
	 * "Tcl_GetCwd" function in succession. A non-NULL return value
	 * indicates the particular function has succeeded.
	 */

	fsRecPtr = FsGetFirstFilesystem();

	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    ClientData retCd;
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;








>







2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
	/*
	 * We've never been called before, try to find a cwd. Call each of the
	 * "Tcl_GetCwd" function in succession. A non-NULL return value
	 * indicates the particular function has succeeded.
	 */

	fsRecPtr = FsGetFirstFilesystem();
	Claim();
	while ((retVal == NULL) && (fsRecPtr != NULL)) {
	    Tcl_FSGetCwdProc *proc = fsRecPtr->fsPtr->getCwdProc;
	    if (proc != NULL) {
		if (fsRecPtr->fsPtr->version != TCL_FILESYSTEM_VERSION_1) {
		    ClientData retCd;
		    TclFSGetCwdProc2 *proc2 = (TclFSGetCwdProc2*)proc;

2667
2668
2669
2670
2671
2672
2673

2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685

2686
2687
2688
2689
2690
2691
2692
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			} else {
			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
			}
			Tcl_DecrRefCount(retVal);
			retVal = NULL;

			goto cdDidNotChange;
		    } else if (interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }
		} else {
		    retVal = (*proc)(interp);
		}
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}


	/*
	 * Now the 'cwd' may NOT be normalized, at least on some platforms.
	 * For the sake of efficiency, we want a completely normalized cwd at
	 * all times.
	 *
	 * Finally, if retVal is NULL, we do not have a cwd, which could be







>












>







2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
			    FsUpdateCwd(norm, retCd);
			    Tcl_DecrRefCount(norm);
			} else {
			    (*fsRecPtr->fsPtr->freeInternalRepProc)(retCd);
			}
			Tcl_DecrRefCount(retVal);
			retVal = NULL;
			Disclaim();
			goto cdDidNotChange;
		    } else if (interp != NULL) {
			Tcl_AppendResult(interp,
				"error getting working directory name: ",
				Tcl_PosixError(interp), NULL);
		    }
		} else {
		    retVal = (*proc)(interp);
		}
	    }
	    fsRecPtr = fsRecPtr->nextPtr;
	}
	Disclaim();

	/*
	 * Now the 'cwd' may NOT be normalized, at least on some platforms.
	 * For the sake of efficiency, we want a completely normalized cwd at
	 * all times.
	 *
	 * Finally, if retVal is NULL, we do not have a cwd, which could be
3624
3625
3626
3627
3628
3629
3630

3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641

3642
3643
3644
3645
3646
3647
3648
     * Call each of the "listVolumes" function in succession. A non-NULL
     * return value indicates the particular function has succeeded. We call
     * all the functions registered, since we want a list of all drives from
     * all filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
	if (proc != NULL) {
	    Tcl_Obj *thisFsVolumes = (*proc)();
	    if (thisFsVolumes != NULL) {
		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
		Tcl_DecrRefCount(thisFsVolumes);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }


    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *







>











>







3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
     * Call each of the "listVolumes" function in succession. A non-NULL
     * return value indicates the particular function has succeeded. We call
     * all the functions registered, since we want a list of all drives from
     * all filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;
	if (proc != NULL) {
	    Tcl_Obj *thisFsVolumes = (*proc)();
	    if (thisFsVolumes != NULL) {
		Tcl_ListObjAppendList(NULL, resultPtr, thisFsVolumes);
		Tcl_DecrRefCount(thisFsVolumes);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
3674
3675
3676
3677
3678
3679
3680

3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693

3694
3695
3696
3697
3698
3699
3700
     * Call each of the "matchInDirectory" functions in succession, with the
     * specific type information 'mountsOnly'. A non-NULL return value
     * indicates the particular function has succeeded. We call all the
     * functions registered, since we want a list from each filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    Tcl_FSMatchInDirectoryProc *proc =
		    fsRecPtr->fsPtr->matchInDirectoryProc;
	    if (proc != NULL) {
		if (resultPtr == NULL) {
		    resultPtr = Tcl_NewObj();
		}
		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }


    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *







>













>







3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
     * Call each of the "matchInDirectory" functions in succession, with the
     * specific type information 'mountsOnly'. A non-NULL return value
     * indicates the particular function has succeeded. We call all the
     * functions registered, since we want a list from each filesystems.
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
	    Tcl_FSMatchInDirectoryProc *proc =
		    fsRecPtr->fsPtr->matchInDirectoryProc;
	    if (proc != NULL) {
		if (resultPtr == NULL) {
		    resultPtr = Tcl_NewObj();
		}
		(*proc)(NULL, resultPtr, pathPtr, pattern, &mountsOnly);
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return resultPtr;
}

/*
 *---------------------------------------------------------------------------
 *
3899
3900
3901
3902
3903
3904
3905

3906
3907
3908
3909
3910
3911
3912
    /*
     * Call each of the "listVolumes" function in succession, checking whether
     * the given path is an absolute path on any of the volumes returned (this
     * is done by checking whether the path's prefix matches).
     */

    fsRecPtr = FsGetFirstFilesystem();

    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;

	/*
	 * We want to skip the native filesystem in this loop because
	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
	 * is because some of the tests artificially change the current







>







3909
3910
3911
3912
3913
3914
3915
3916
3917
3918
3919
3920
3921
3922
3923
    /*
     * Call each of the "listVolumes" function in succession, checking whether
     * the given path is an absolute path on any of the volumes returned (this
     * is done by checking whether the path's prefix matches).
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();
    while (fsRecPtr != NULL) {
	Tcl_FSListVolumesProc *proc = fsRecPtr->fsPtr->listVolumesProc;

	/*
	 * We want to skip the native filesystem in this loop because
	 * otherwise we won't necessarily pass all the Tcl testsuite -- this
	 * is because some of the tests artificially change the current
3977
3978
3979
3980
3981
3982
3983

3984
3985
3986
3987
3988
3989
3990
		     */
		    break;
		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }

    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --







>







3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
		     */
		    break;
		}
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();
    return type;
}

/*
 *---------------------------------------------------------------------------
 *
 * Tcl_FSRenameFile --
4371
4372
4373
4374
4375
4376
4377

4378
4379
4380
4381
4382
4383
4384
     * Check if the filesystem has changed in some way since this object's
     * internal representation was calculated. Before doing that, assure we
     * have the most up-to-date copy of the master filesystem. This is
     * accomplished by the FsGetFirstFilesystem() call.
     */

    fsRecPtr = FsGetFirstFilesystem();


    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Call each of the "pathInFilesystem" functions in succession. A







>







4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
     * Check if the filesystem has changed in some way since this object's
     * internal representation was calculated. Before doing that, assure we
     * have the most up-to-date copy of the master filesystem. This is
     * accomplished by the FsGetFirstFilesystem() call.
     */

    fsRecPtr = FsGetFirstFilesystem();
    Claim();

    if (TclFSEnsureEpochOk(pathPtr, &retVal) != TCL_OK) {
	return NULL;
    }

    /*
     * Call each of the "pathInFilesystem" functions in succession. A
4399
4400
4401
4402
4403
4404
4405

4406
4407
4408
4409
4410
4411
4412

		TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }


    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *







>







4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426

		TclFSSetPathDetails(pathPtr, fsRecPtr->fsPtr, clientData);
		retVal = fsRecPtr->fsPtr;
	    }
	}
	fsRecPtr = fsRecPtr->nextPtr;
    }
    Disclaim();

    return retVal;
}

/*
 *---------------------------------------------------------------------------
 *

Changes to generic/tclPathObj.c.

559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
    Tcl_Interp *interp,		/* Used for error reporting */
    Tcl_Obj *pathPtr,		/* Path to take dirname of */
    Tcl_PathPart portion)	/* Requested portion of name */
{
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (TclFSEpochOk(fsPathPtr->filesystemEpoch)
		&& (PATHFLAGS(pathPtr) != 0)) {
	    switch (portion) {
	    case TCL_PATH_DIRNAME: {
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use







<
|







559
560
561
562
563
564
565

566
567
568
569
570
571
572
573
    Tcl_Interp *interp,		/* Used for error reporting */
    Tcl_Obj *pathPtr,		/* Path to take dirname of */
    Tcl_PathPart portion)	/* Requested portion of name */
{
    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);


	if (PATHFLAGS(pathPtr) != 0) {
	    switch (portion) {
	    case TCL_PATH_DIRNAME: {
		/*
		 * Check if the joined-on bit has any directory delimiters in
		 * it. If so, the 'dirname' would be a joining of the main
		 * part with the dirname of the joined-on bit. We could handle
		 * that special case here, but we don't, and instead just use
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
    fsPathPtr->cwdPtr = dirPtr;
    Tcl_IncrRefCount(dirPtr);
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
    pathPtr->typePtr = &tclFsPathType;
    pathPtr->bytes = NULL;
    pathPtr->length = 0;








|







1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
    fsPathPtr->translatedPathPtr = NULL;
    fsPathPtr->normPathPtr = Tcl_NewStringObj(addStrRep, len);
    Tcl_IncrRefCount(fsPathPtr->normPathPtr);
    fsPathPtr->cwdPtr = dirPtr;
    Tcl_IncrRefCount(dirPtr);
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    fsPathPtr->filesystemEpoch = 0;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
    pathPtr->typePtr = &tclFsPathType;
    pathPtr->bytes = NULL;
    pathPtr->length = 0;

1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
TclFSMakePathRelative(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    int cwdLen, len;
    const char *tempStr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0
		&& fsPathPtr->cwdPtr == cwdPtr) {
	    pathPtr = fsPathPtr->normPathPtr;







<







1412
1413
1414
1415
1416
1417
1418

1419
1420
1421
1422
1423
1424
1425
TclFSMakePathRelative(
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr,		/* The path we have. */
    Tcl_Obj *cwdPtr)		/* Make it relative to this. */
{
    int cwdLen, len;
    const char *tempStr;


    if (pathPtr->typePtr == &tclFsPathType) {
	FsPath *fsPathPtr = PATHOBJ(pathPtr);

	if (PATHFLAGS(pathPtr) != 0
		&& fsPathPtr->cwdPtr == cwdPtr) {
	    pathPtr = fsPathPtr->normPathPtr;
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491

	    fsPathPtr->translatedPathPtr = pathPtr;
	    fsPathPtr->normPathPtr = NULL;
	    fsPathPtr->cwdPtr = cwdPtr;
	    Tcl_IncrRefCount(cwdPtr);
	    fsPathPtr->nativePathPtr = NULL;
	    fsPathPtr->fsPtr = NULL;
	    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

	    SETPATHOBJ(pathPtr, fsPathPtr);
	    PATHFLAGS(pathPtr) = 0;
	    pathPtr->typePtr = &tclFsPathType;

	    return pathPtr;
	}







|







1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489

	    fsPathPtr->translatedPathPtr = pathPtr;
	    fsPathPtr->normPathPtr = NULL;
	    fsPathPtr->cwdPtr = cwdPtr;
	    Tcl_IncrRefCount(cwdPtr);
	    fsPathPtr->nativePathPtr = NULL;
	    fsPathPtr->fsPtr = NULL;
	    fsPathPtr->filesystemEpoch = 0;

	    SETPATHOBJ(pathPtr, fsPathPtr);
	    PATHFLAGS(pathPtr) = 0;
	    pathPtr->typePtr = &tclFsPathType;

	    return pathPtr;
	}
1587
1588
1589
1590
1591
1592
1593

1594
1595
1596
1597
1598
1599
1600
     * Circular reference by design.
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;

    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;







>







1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
     * Circular reference by design.
     */

    fsPathPtr->normPathPtr = pathPtr;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    /* Remember the epoch under which we decided pathPtr was normalized */
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;

    return TCL_OK;
1723
1724
1725
1726
1727
1728
1729






1730
1731
1732
1733
1734
1735
1736
	    if (translatedCwdPtr == NULL) {
		return NULL;
	    }

	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
		    &(srcFsPathPtr->normPathPtr));
	    srcFsPathPtr->translatedPathPtr = retObj;






	    Tcl_IncrRefCount(retObj);
	    Tcl_DecrRefCount(translatedCwdPtr);
	} else {
	    /*
	     * It is a pure absolute, normalized path object. This is
	     * something like being a 'pure list'. The object's string,
	     * translatedPath and normalizedPath are all identical.







>
>
>
>
>
>







1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
	    if (translatedCwdPtr == NULL) {
		return NULL;
	    }

	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
		    &(srcFsPathPtr->normPathPtr));
	    srcFsPathPtr->translatedPathPtr = retObj;
	    if (translatedCwdPtr->typePtr == &tclFsPathType) {
		srcFsPathPtr->filesystemEpoch
			= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
	    } else {
		srcFsPathPtr->filesystemEpoch = 0;
	    }
	    Tcl_IncrRefCount(retObj);
	    Tcl_DecrRefCount(translatedCwdPtr);
	} else {
	    /*
	     * It is a pure absolute, normalized path object. This is
	     * something like being a 'pure list'. The object's string,
	     * translatedPath and normalizedPath are all identical.
2523
2524
2525
2526
2527
2528
2529




2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
     */

    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);




    }
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;
    fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;

    /*
     * Free old representation before installing our new one.
     */

    TclFreeIntRep(pathPtr);
    SETPATHOBJ(pathPtr, fsPathPtr);







>
>
>
>





<







2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
     */

    fsPathPtr = (FsPath *) ckalloc(sizeof(FsPath));

    fsPathPtr->translatedPathPtr = transPtr;
    if (transPtr != pathPtr) {
	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
	/* Redo translation when $env(HOME) changes */
	fsPathPtr->filesystemEpoch = tsdPtr->filesystemEpoch;
    } else {
	fsPathPtr->filesystemEpoch = 0;
    }
    fsPathPtr->normPathPtr = NULL;
    fsPathPtr->cwdPtr = NULL;
    fsPathPtr->nativePathPtr = NULL;
    fsPathPtr->fsPtr = NULL;


    /*
     * Free old representation before installing our new one.
     */

    TclFreeIntRep(pathPtr);
    SETPATHOBJ(pathPtr, fsPathPtr);