[24427] trunk/base/src/pextlib1.0

[source_changes at macosforge.org]

Revision: 24427
          http://trac.macosforge.org/projects/macports/changeset/24427
Author:   eridius at macports.org
Date:     2007-04-24 01:14:22 -0700 (Tue, 24 Apr 2007)

Log Message:
-----------
Add test for deleting files during traversal

Modified Paths:
--------------
    trunk/base/src/pextlib1.0/fs-traverse.c
    trunk/base/src/pextlib1.0/tests/fs-traverse.tcl

Modified: trunk/base/src/pextlib1.0/fs-traverse.c
===================================================================
--- trunk/base/src/pextlib1.0/fs-traverse.c	2007-04-24 08:06:37 UTC (rev 24426)
+++ trunk/base/src/pextlib1.0/fs-traverse.c	2007-04-24 08:14:22 UTC (rev 24427)
@@ -58,7 +58,7 @@
 
 #include <tcl.h>
 
-static int do_traverse(Tcl_Interp *interp, int flags, char * CONST *targets, char *varname, Tcl_Obj *body);
+static int do_traverse(Tcl_Interp *interp, int flags, char * CONST *targets, Tcl_Obj *varname, Tcl_Obj *body);
 
 #define F_DEPTH 0x1
 #define F_IGNORE_ERRORS 0x2
@@ -67,7 +67,7 @@
 int
 FsTraverseCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
 {
-    char *varname;
+    Tcl_Obj *varname;
     Tcl_Obj *body;
     int flags = 0;
     int rval = TCL_OK;
@@ -100,7 +100,7 @@
         return TCL_ERROR;
     }
     
-    varname = Tcl_GetString(*objv);
+    varname = *objv;
     ++objv, --objc;
     
     listPtr = *objv;
@@ -122,7 +122,7 @@
 }
 
 static int
-do_traverse(Tcl_Interp *interp, int flags, char * CONST *targets, char *varname, Tcl_Obj *body)
+do_traverse(Tcl_Interp *interp, int flags, char * CONST *targets, Tcl_Obj *varname, Tcl_Obj *body)
 {
     int rval = TCL_OK;
     FTS *root_fts;
@@ -136,7 +136,8 @@
             case FTS_DP: /* directory in post-order*/
             {
                 if (!(flags & F_DEPTH) != !(ent->fts_info == FTS_D)) {
-                    Tcl_SetVar(interp, varname, ent->fts_path, 0);
+                    Tcl_Obj *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+                    Tcl_ObjSetVar2(interp, varname, NULL, path, 0);
                     if ((rval = Tcl_EvalObjEx(interp, body, 0)) == TCL_CONTINUE) {
                         fts_set(root_fts, ent, FTS_SKIP);
                     } else if (rval == TCL_BREAK) {

Modified: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 08:06:37 UTC (rev 24426)
+++ trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 08:14:22 UTC (rev 24427)
@@ -78,10 +78,10 @@
         # Test skipping parts of the tree
         set output [list]
         fs-traverse file $root {
-            lappend output $file
             if {[string match */a $file]} {
                 continue
             }
+            lappend output $file
         }
         check_output $output $trees(5)
         
@@ -93,6 +93,19 @@
                 break
             }
         }
+        
+        # NOTE: This should be the last test performed, as it modifies the file tree
+        # Test to make sure deleting files during traversal works as expected
+        set output [list]
+        fs-traverse file $root {
+            if {[string match */a $file]} {
+                # use /bin/rm because on 10.3 file delete doesn't work on directories properly
+                exec /bin/rm -rf $file
+                continue
+            }
+            lappend output $file
+        }
+        check_output $output $trees(5)
     } errMsg]
     set savedInfo $errorInfo
     
@@ -269,12 +282,9 @@
     
     set trees(5) "
         $root           directory
-        $root/a         directory
         $root/b         directory
-        $root/b/a       directory
         $root/b/b       directory
         $root/b/c       directory
-        $root/b/c/a     file
         $root/b/c/b     file
         $root/b/c/c     file
     "

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070424/590d021d/attachment.html