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

source_changes at macosforge.org source_changes at macosforge.org
Mon Apr 23 22:21:27 PDT 2007


Revision: 24407
          http://trac.macosforge.org/projects/macports/changeset/24407
Author:   eridius at macports.org
Date:     2007-04-23 22:21:26 -0700 (Mon, 23 Apr 2007)

Log Message:
-----------
Add comprehensive tests for fs-traverse

Modified Paths:
--------------
    trunk/base/src/pextlib1.0/Makefile

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

Modified: trunk/base/src/pextlib1.0/Makefile
===================================================================
--- trunk/base/src/pextlib1.0/Makefile	2007-04-24 04:52:29 UTC (rev 24406)
+++ trunk/base/src/pextlib1.0/Makefile	2007-04-24 05:21:26 UTC (rev 24407)
@@ -15,4 +15,5 @@
 	${TCLSH} tests/checksums.tcl ${SHLIB_NAME}
 	${TCLSH} tests/filemap.tcl ${SHLIB_NAME}
 	${TCLSH} tests/fifo.tcl ${SHLIB_NAME}
+	${TCLSH} tests/fs-traverse.tcl ${SHLIB_NAME}
 	${TCLSH} tests/socketpair.tcl ${SHLIB_NAME}

Added: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	                        (rev 0)
+++ trunk/base/src/pextlib1.0/tests/fs-traverse.tcl	2007-04-24 05:21:26 UTC (rev 24407)
@@ -0,0 +1,235 @@
+# Test file for Pextlib's fs-traverse
+# Requires r/w access to /tmp
+# Syntax:
+# tclsh fs-traverse.tcl <Pextlib name>
+
+proc main {pextlibname} {
+    global tree1 tree2 tree3 tree4 errorInfo
+    
+    load $pextlibname
+    
+    set root "/tmp/macports-pextlib-fs-traverse"
+    
+    file delete -force $root
+    
+    setup_trees $root
+    
+    # make the directory root structure
+    make_root
+    
+    # perform tests
+    set result [catch {
+        # Basic fs-traverse test
+        set output [list]
+        fs-traverse file $root {
+            lappend output $file
+        }
+        check_output $output $tree1
+        
+        # Test -depth
+        set output [list]
+        fs-traverse -depth file $root {
+            lappend output $file
+        }
+        check_output $output $tree2
+        
+        # Test multiple sources
+        set output [list]
+        fs-traverse file $root/a $root/b {
+            lappend output $file
+        }
+        check_output $output $tree3
+        
+        # Test multiple sources with -depth
+        set output [list]
+        fs-traverse -depth file $root/a $root/b {
+            lappend output $file
+        }
+        check_output $output $tree4
+        
+        # Error raised for traversing directory that does not exist
+        if {![catch {fs-traverse file $root/does_not_exist {}}]} {
+            error "fs-traverse did not raise an error for a missing directory"
+        }
+        
+        # Test -ignoreErrors
+        if {[catch {fs-traverse -ignoreErrors file $root/does_not_exist {}}]} {
+            error "fs-traverse raised an error despite -ignoreErrors"
+        }
+        
+        # Test -ignoreErrors with multiple sources, make sure it still gets the sources after the error
+        if {[catch {
+            set output [list]
+            fs-traverse -depth -ignoreErrors file $root/a $root/c $root/b {
+                lappend output $file
+            }
+            check_output $output $tree4
+        }]} {
+            error "fs-traverse raised an error despite -ignoreErrors"
+        }
+    } errMsg]
+    set savedInfo $errorInfo
+    
+    # Clean up
+    file delete -force $root
+    
+    # Re-raise error if one occurred in the test block
+    if {$result} {
+        error $errMsg $savedInfo
+    }
+}
+
+proc check_output {output tree} {
+    foreach file $output {entry typelist} $tree {
+        set type [lindex $typelist 0]
+        set link [lindex $typelist 1]
+        if {$file ne $entry} {
+            error "Found `$file', expected `$entry'"
+        } elseif {[file type $file] ne $type} {
+            error "File `$file' had type `[file type $file]', expected type `$type'"
+        } elseif {$type eq "link" && [file readlink $file] ne $link} {
+            error "File `$file' linked to `[file readlink $file]', expected link to `$link'"
+        }
+    }
+}
+
+proc make_root {} {
+    global tree1
+    foreach {entry typelist} $tree1 {
+        set type [lindex $typelist 0]
+        set link [lindex $typelist 1]
+        switch $type {
+            directory {
+                file mkdir $entry
+            }
+            file {
+                # touch
+                close [open $entry w]
+            }
+            link {
+                # file link doesn't let you link to files that don't exist
+                # so lets farm out to /bin/ln
+                exec /bin/ln -s $link $entry
+            }
+            default {
+                return -code error "Unknown file map type: $typelist"
+            }
+        }
+    }
+}
+
+proc setup_trees {root} {
+    global tree1 tree2 tree3 tree4
+    
+    set tree1 "
+        $root           directory
+        $root/a         directory
+        $root/a/a       file
+        $root/a/b       file
+        $root/a/c       directory
+        $root/a/c/a     {link ../d}
+        $root/a/c/b     file
+        $root/a/c/c     directory
+        $root/a/c/d     file
+        $root/a/d       directory
+        $root/a/d/a     file
+        $root/a/d/b     {link ../../b/a}
+        $root/a/d/c     directory
+        $root/a/d/d     file
+        $root/a/e       file
+        $root/b         directory
+        $root/b/a       directory
+        $root/b/a/a     file
+        $root/b/a/b     file
+        $root/b/a/c     file
+        $root/b/b       directory
+        $root/b/c       directory
+        $root/b/c/a     file
+        $root/b/c/b     file
+        $root/b/c/c     file
+    "
+    
+    set tree2 "
+        $root/a/a       file
+        $root/a/b       file
+        $root/a/c/a     {link ../d}
+        $root/a/c/b     file
+        $root/a/c/c     directory
+        $root/a/c/d     file
+        $root/a/c       directory
+        $root/a/d/a     file
+        $root/a/d/b     {link ../../b/a}
+        $root/a/d/c     directory
+        $root/a/d/d     file
+        $root/a/d       directory
+        $root/a/e       file
+        $root/a         directory
+        $root/b/a/a     file
+        $root/b/a/b     file
+        $root/b/a/c     file
+        $root/b/a       directory
+        $root/b/b       directory
+        $root/b/c/a     file
+        $root/b/c/b     file
+        $root/b/c/c     file
+        $root/b/c       directory
+        $root/b         directory
+        $root           directory
+    "
+    
+    set tree3 "
+        $root/a         directory
+        $root/a/a       file
+        $root/a/b       file
+        $root/a/c       directory
+        $root/a/c/a     {link ../d}
+        $root/a/c/b     file
+        $root/a/c/c     directory
+        $root/a/c/d     file
+        $root/a/d       directory
+        $root/a/d/a     file
+        $root/a/d/b     {link ../../b/a}
+        $root/a/d/c     directory
+        $root/a/d/d     file
+        $root/a/e       file
+        $root/b         directory
+        $root/b/a       directory
+        $root/b/a/a     file
+        $root/b/a/b     file
+        $root/b/a/c     file
+        $root/b/b       directory
+        $root/b/c       directory
+        $root/b/c/a     file
+        $root/b/c/b     file
+        $root/b/c/c     file
+    "
+    
+    set tree4 "
+        $root/a/a       file
+        $root/a/b       file
+        $root/a/c/a     {link ../d}
+        $root/a/c/b     file
+        $root/a/c/c     directory
+        $root/a/c/d     file
+        $root/a/c       directory
+        $root/a/d/a     file
+        $root/a/d/b     {link ../../b/a}
+        $root/a/d/c     directory
+        $root/a/d/d     file
+        $root/a/d       directory
+        $root/a/e       file
+        $root/a         directory
+        $root/b/a/a     file
+        $root/b/a/b     file
+        $root/b/a/c     file
+        $root/b/a       directory
+        $root/b/b       directory
+        $root/b/c/a     file
+        $root/b/c/b     file
+        $root/b/c/c     file
+        $root/b/c       directory
+        $root/b         directory
+    "
+}
+
+main $argv
\ No newline at end of file


Property changes on: trunk/base/src/pextlib1.0/tests/fs-traverse.tcl
___________________________________________________________________
Name: svn:keywords
   + Id
Name: svn:eol-style
   + native

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/macports-changes/attachments/20070423/3ea3c092/attachment.html


More information about the macports-changes mailing list