[24437] trunk/base/src/port1.0/tests/portutil.tcl

[source_changes at macosforge.org]

Revision: 24437
          http://trac.macosforge.org/projects/macports/changeset/24437
Author:   eridius at macports.org
Date:     2007-04-24 03:55:39 -0700 (Tue, 24 Apr 2007)

Log Message:
-----------
Add tests for touch

Modified Paths:
--------------
    trunk/base/src/port1.0/tests/portutil.tcl

Modified: trunk/base/src/port1.0/tests/portutil.tcl
===================================================================
--- trunk/base/src/port1.0/tests/portutil.tcl	2007-04-24 10:23:44 UTC (rev 24436)
+++ trunk/base/src/port1.0/tests/portutil.tcl	2007-04-24 10:55:39 UTC (rev 24437)
@@ -95,6 +95,37 @@
     file delete -force $root
 }
 
+proc test_touch {} {
+    set root "/tmp/macports-portutil-touch"
+    file delete -force $root
+    
+    try {
+        touch -c $root
+        if {[file exists $root]} { error "touch failed" }
+    
+        touch $root
+        if {![file exists $root]} { error "touch failed" }
+    
+        touch -a -t 199912010001.01 $root
+        if {[file atime $root] != [clock scan 19991201T000101]} { error "touch failed" }
+        if {[file mtime $root] == [clock scan 19991201T000101]} { error "touch failed" }
+    
+        touch -m -t 200012010001.01 $root
+        if {[file atime $root] == [clock scan 20001201T000101]} { error "touch failed" }
+        if {[file mtime $root] != [clock scan 20001201T000101]} { error "touch failed" }
+    
+        touch -a -m -t 200112010001.01 $root
+        if {[file atime $root] != [clock scan 20011201T000101]} { error "touch failed" }
+        if {[file mtime $root] != [clock scan 20011201T000101]} { error "touch failed" }
+    
+        touch -r ~ $root
+        if {[file atime $root] != [file atime ~]} { error "touch failed" }
+        if {[file mtime $root] != [file mtime ~]} { error "touch failed" }
+    } finally {
+        file delete -force $root
+    }
+}
+
 # Create a filesystem hierarchy based on the given specification
 # The mtree spec consists of name/type pairings, where type can be
 # one of directory, file or link. If type is link, it must be a
@@ -124,6 +155,22 @@
     }
 }
 
+# try-finally block
+# Usage: try { script1 } finally { script2 }
+proc try {script1 finally script2} {
+    if {$finally ne "finally"} {
+        error "Usage: try { script1 } finally { script2 }"
+    }
+    if {[set fail [catch {uplevel $script1} result]]} {
+        set savedInfo $::errorInfo
+        set savedCode $::errorCode
+    }
+    uplevel $script2
+    if {$fail} {
+        return -code $fail -errorinfo $savedInfo -errorcode $savedCode $result
+    }
+}
+
 # run all tests
 foreach proc [info procs test_*] {
     $proc

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