Tcl Source Code

Check-in [c5efc3eed0]
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:
* unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to * tests/fCmd.test (fCmd-20.2): account for NFS special files with a readdir rewind threshold. [Bug 1034337]
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | kennykb-numerics-branch-20051008 | msofer-wcodes-branch-20051007
Files: files | file ages | folders
SHA1: c5efc3eed050293c0ee5e518fbc7a897fe16e2cb
User & Date: hobbs 2005-10-07 22:35:33
Context
2005-10-08
14:42
TIP#237 IMPLEMENTATION
[kennykb-numerics-branch] Resynchronized with the HEAD; at t...
check-in: 83fdb360a9 user: dgp tags: trunk
2005-10-07
22:35
* unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to * tests/fCmd.test (fCmd-20.2)...
check-in: c5efc3eed0 user: hobbs tags: trunk, kennykb-numerics-branch-20051008, msofer-wcodes-branch-20051007
2005-10-05
22:09
* generic/tclPipe.c (TclCreatePipeline): Fixed [SF Tcl Bug 1109294]. Applied the patch provided... check-in: 9a439d406a user: andreas_kupries tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.







1
2
3
4
5
6
7





2005-10-05  Andreas Kupries <[email protected]>

	* generic/tclPipe.c (TclCreatePipeline): Fixed [SF Tcl Bug
	  1109294]. Applied the patch provided by David Gravereaux.

	* doc/CrtChannel.3: Fixed [SF Tcl Bug 1104682], by application of
	  David Welton's patch for it, and added a note about
>
>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
13
2005-10-07  Jeff Hobbs  <[email protected]>

	* unix/tclUnixFCmd.c (TraverseUnixTree): Adjust 2004-11-11 change to
	* tests/fCmd.test (fCmd-20.2):           account for NFS special
	files with a readdir rewind threshold. [Bug 1034337]

2005-10-05  Andreas Kupries <[email protected]>

	* generic/tclPipe.c (TclCreatePipeline): Fixed [SF Tcl Bug
	  1109294]. Applied the patch provided by David Gravereaux.

	* doc/CrtChannel.3: Fixed [SF Tcl Bug 1104682], by application of
	  David Welton's patch for it, and added a note about

Changes to tests/fCmd.test.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: fCmd.test,v 1.46 2005/05/10 18:35:19 kennykb Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

................................................................................
    set result
} {1}

test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \
	{unix notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    for {set i 1} {$i <= 200} {incr i} {createfile tfa/testfile_$i}
    set result [catch {file delete -force tfa} msg]
    while {[catch {file delete -force tfa}]} {}
    list $result $msg
} {0 {}}

#
# Feature testing for TclCopyFilesCmd






|







 







|







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
....
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
# Copyright (c) 1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: fCmd.test,v 1.47 2005/10/07 22:35:33 hobbs Exp $
#

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

................................................................................
    set result
} {1}

test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \
	{unix notRoot} {
    catch {file delete -force -- tfa}
    file mkdir tfa
    for {set i 1} {$i <= 300} {incr i} {createfile tfa/testfile_$i}
    set result [catch {file delete -force tfa} msg]
    while {[catch {file delete -force tfa}]} {}
    list $result $msg
} {0 {}}

#
# Feature testing for TclCopyFilesCmd

Changes to unix/tclUnixFCmd.c.

6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
158
159
160
161
162
163
164
















165
166
167
168
169
170
171
...
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
...
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935

936
937
938
939
940
941
942
943
944
945
946




947

948

949
950

951
952
953
954
955
956
957
 *	already be translated to native format.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixFCmd.c,v 1.45 2005/09/15 16:40:03 dgp Exp $
 *
 * Portions of this code were derived from NetBSD source code which has the
 * following copyright notice:
 *
 * Copyright (c) 1988, 1993, 1994
 *      The Regents of the University of California.  All rights reserved.
 *
................................................................................
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
#endif
};
#endif
















/*
 * Declarations for local procedures defined in this file:
 */

static int		CopyFileAtts _ANSI_ARGS_((CONST char *src,
			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
static int		DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
................................................................................
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    CONST char *source, *errfile;
    int result, sourceLen;
    int targetLen;
    int needRewind;
    Tcl_DirEntry *dirEntPtr;
    DIR *dirPtr;

    errfile = NULL;
    result = TCL_OK;
    targetLen = 0;		/* lint. */

................................................................................
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	Tcl_DStringAppend(targetPtr, "/", 1);
	targetLen = Tcl_DStringLength(targetPtr);
    }

    do {
	needRewind = 0;
	while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native */
	    if ((dirEntPtr->d_name[0] == '.')
		    && ((dirEntPtr->d_name[1] == '\0')
			    || (strcmp(dirEntPtr->d_name, "..") == 0))) {
		continue;
	    }

	    /*
	     * Append name after slash, and recurse on the file.
	     */

	    Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);
	    if (targetPtr != NULL) {
		Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);
	    }
	    result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
		    errorPtr, doRewind);
	    if (result != TCL_OK) {
	    	needRewind = 0;
		break;
	    } else {
		needRewind = doRewind;

	    }

	    /*
	     * Remove name after slash.
	     */

	    Tcl_DStringSetLength(sourcePtr, sourceLen);
	    if (targetPtr != NULL) {
		Tcl_DStringSetLength(targetPtr, targetLen);
	    }
	}




	if (needRewind) {

	    rewinddir(dirPtr);

	}
    } while (needRewind);

    closedir(dirPtr);

    /*
     * Strip off the trailing slash we added
     */

    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);






|







 







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







 







|







 







<
<
|
|
|
|
|
|

|
|
|

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

|
|
|

|
|
|
|
<
>
>
>
>
|
>

>

<
>







6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
...
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
...
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
...
921
922
923
924
925
926
927


928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945

946
947

948
949
950
951
952
953
954
955
956
957
958

959
960
961
962
963
964
965
966
967

968
969
970
971
972
973
974
975
 *	already be translated to native format.
 *
 * Copyright (c) 1996-1998 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tclUnixFCmd.c,v 1.46 2005/10/07 22:35:33 hobbs Exp $
 *
 * Portions of this code were derived from NetBSD source code which has the
 * following copyright notice:
 *
 * Copyright (c) 1988, 1993, 1994
 *      The Regents of the University of California.  All rights reserved.
 *
................................................................................
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
    {TclMacOSXGetFileAttribute,	TclMacOSXSetFileAttribute},
#endif
};
#endif

/*
 * This is the maximum number of consecutive readdir/unlink calls that can be
 * made (with no intervening rewinddir or closedir/opendir) before triggering
 * a bug that makes readdir return NULL even though some directory entries
 * have not been processed.  The bug afflicts SunOS's readdir when applied to
 * ufs file systems and Darwin 6.5's (and OSX v.10.3.8's) HFS+.  JH found the
 * Darwin readdir to reset at 172, so 150 is chosen to be conservative.  We
 * can't do a general rewind on failure as NFS can create special files that
 * recreate themselves when you try and delete them.  8.4.8 added a solution
 * that was affected by a single such NFS file, this solution should not be
 * affected by less than THRESHOLD such files. [Bug 1034337]
 */

#define MAX_READDIR_UNLINK_THRESHOLD 150

/*
 * Declarations for local procedures defined in this file:
 */

static int		CopyFileAtts _ANSI_ARGS_((CONST char *src,
			    CONST char *dst, CONST Tcl_StatBuf *statBufPtr));
static int		DoCopyFile _ANSI_ARGS_((CONST char *srcPtr,
................................................................................
    				 * source hierarchy, e.g. by deleting
    				 * files. */
{
    Tcl_StatBuf statBuf;
    CONST char *source, *errfile;
    int result, sourceLen;
    int targetLen;
    int numProcessed = 0;
    Tcl_DirEntry *dirEntPtr;
    DIR *dirPtr;

    errfile = NULL;
    result = TCL_OK;
    targetLen = 0;		/* lint. */

................................................................................
    sourceLen = Tcl_DStringLength(sourcePtr);

    if (targetPtr != NULL) {
	Tcl_DStringAppend(targetPtr, "/", 1);
	targetLen = Tcl_DStringLength(targetPtr);
    }



    while ((dirEntPtr = TclOSreaddir(dirPtr)) != NULL) { /* INTL: Native. */
	if ((dirEntPtr->d_name[0] == '.')
		&& ((dirEntPtr->d_name[1] == '\0')
			|| (strcmp(dirEntPtr->d_name, "..") == 0))) {
	    continue;
	}

	/*
	 * Append name after slash, and recurse on the file.
	 */

	Tcl_DStringAppend(sourcePtr, dirEntPtr->d_name, -1);
	if (targetPtr != NULL) {
	    Tcl_DStringAppend(targetPtr, dirEntPtr->d_name, -1);
	}
	result = TraverseUnixTree(traverseProc, sourcePtr, targetPtr,
		errorPtr, doRewind);
	if (result != TCL_OK) {

	    break;
	} else {

	    numProcessed++;
	}

	/*
	 * Remove name after slash.
	 */

	Tcl_DStringSetLength(sourcePtr, sourceLen);
	if (targetPtr != NULL) {
	    Tcl_DStringSetLength(targetPtr, targetLen);
	}

	if (doRewind && (numProcessed > MAX_READDIR_UNLINK_THRESHOLD)) {
	    /*
	     * Call rewinddir if we've called unlink or rmdir so many times
	     * (since the opendir or the previous rewinddir), to avoid
	     * a NULL-return that may a symptom of a buggy readdir.
	     */
	    rewinddir(dirPtr);
	    numProcessed = 0;
	}

    }
    closedir(dirPtr);

    /*
     * Strip off the trailing slash we added
     */

    Tcl_DStringSetLength(sourcePtr, sourceLen - 1);