[24422] trunk/base/src/pextlib1.0/tests/fs-traverse.tcl

[source_changes at macosforge.org]

Revision: 24422
          http://trac.macosforge.org/projects/macports/changeset/24422
Author:   eridius at macports.org
Date:     2007-04-24 00:36:53 -0700 (Tue, 24 Apr 2007)

Log Message:
-----------
Add some more tests, this time about break/continue during traversal

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

Modified: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 07:33:43 UTC (rev 24421)
+++ trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 07:36:53 UTC (rev 24422)
@@ -4,7 +4,7 @@
 # tclsh fs-traverse.tcl <Pextlib name>
 
 proc main {pextlibname} {
-    global tree1 sub_tree1 tree2 tree3 tree4 errorInfo
+    global trees errorInfo
     
     load $pextlibname
     
@@ -24,35 +24,35 @@
         fs-traverse file $root {
             lappend output $file
         }
-        check_output $output $tree1
+        check_output $output $trees(1)
         
         # Test starting with a symlink
         set output [list]
         fs-traverse file $root/a/c/a {
             lappend output $file
         }
-        check_output $output $sub_tree1
+        check_output $output $trees(sub1)
         
         # Test -depth
         set output [list]
         fs-traverse -depth file $root {
             lappend output $file
         }
-        check_output $output $tree2
+        check_output $output $trees(2)
         
         # Test multiple sources
         set output [list]
         fs-traverse file [list $root/a $root/b] {
             lappend output $file
         }
-        check_output $output $tree3
+        check_output $output $trees(3)
         
         # Test multiple sources with -depth
         set output [list]
         fs-traverse -depth file [list $root/a $root/b] {
             lappend output $file
         }
-        check_output $output $tree4
+        check_output $output $trees(4)
         
         # Error raised for traversing directory that does not exist
         if {![catch {fs-traverse file $root/does_not_exist {}}]} {
@@ -70,10 +70,29 @@
             fs-traverse -depth -ignoreErrors file [list $root/a $root/c $root/b] {
                 lappend output $file
             }
-            check_output $output $tree4
+            check_output $output $trees(4)
         }]} {
             error "fs-traverse raised an error despite -ignoreErrors"
         }
+        
+        # Test skipping parts of the tree
+        set output [list]
+        fs-traverse file $root {
+            lappend output $file
+            if {[string match */a $file]} {
+                continue
+            }
+        }
+        check_output $output $trees(5)
+        
+        # Test cutting the traversal short
+        set output [list]
+        fs-traverse file $root {
+            lappend output $file
+            if {[file type $file] eq "link"} {
+                break
+            }
+        }
     } errMsg]
     set savedInfo $errorInfo
     
@@ -101,8 +120,8 @@
 }
 
 proc make_root {} {
-    global tree1
-    foreach {entry typelist} $tree1 {
+    global trees
+    foreach {entry typelist} $trees(1) {
         set type [lindex $typelist 0]
         set link [lindex $typelist 1]
         switch $type {
@@ -126,9 +145,11 @@
 }
 
 proc setup_trees {root} {
-    global tree1 sub_tree1 tree2 tree3 tree4
+    global trees
     
-    set tree1 "
+    array set trees {}
+    
+    set trees(1) "
         $root           directory
         $root/a         directory
         $root/a/a       file
@@ -156,7 +177,7 @@
         $root/b/c/c     file
     "
     
-    set sub_tree1 "
+    set trees(sub1) "
         $root/a/c/a     {link ../d}
         $root/a/c/a/a   file
         $root/a/c/a/b   {link ../../b/a}
@@ -164,7 +185,7 @@
         $root/a/c/a/d   file
     "
     
-    set tree2 "
+    set trees(2) "
         $root/a/a       file
         $root/a/b       file
         $root/a/c/a     {link ../d}
@@ -192,7 +213,7 @@
         $root           directory
     "
     
-    set tree3 "
+    set trees(3) "
         $root/a         directory
         $root/a/a       file
         $root/a/b       file
@@ -219,7 +240,7 @@
         $root/b/c/c     file
     "
     
-    set tree4 "
+    set trees(4) "
         $root/a/a       file
         $root/a/b       file
         $root/a/c/a     {link ../d}
@@ -245,6 +266,27 @@
         $root/b/c       directory
         $root/b         directory
     "
+    
+    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
+    "
+    
+    set trees(6) "
+        $root           directory
+        $root/a         directory
+        $root/a/a       file
+        $root/a/b       file
+        $root/a/c       directory
+        $root/a/c/a     {link ../d}
+    "
 }
 
 main $argv
\ No newline at end of file

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