[Guile-commits] 01/01: ftw test should handle missing symlink procedure

[Mike Gran]

mike121 pushed a commit to branch wip-mingw-guile-2.2
in repository guile.

commit 34131e3ac5c8b78893931a98252d9bca15f062f1
Author: Michael Gran <address@hidden>
Date:   Mon Apr 16 21:07:15 2018 -0700

    ftw test should handle missing symlink procedure
    
    Throw unresolved if symlink is not defined
    
    * test-suite/tests/ftw.test (dangling symlink and lstat): modified
      (dangling symlink and stat): modified
      (file-system-tree test-suite): modified
      (symlink to directory): modified
---
 test-suite/tests/ftw.test | 83 +++++++++++++++++++++++++----------------------
 1 file changed, 45 insertions(+), 38 deletions(-)

diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index 25556d7..7a5c70e 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -253,37 +253,41 @@
               (file-system-fold enter? leaf down up skip error '() name))))))
 
   (pass-if "dangling symlink and lstat"
-    (with-file-tree %top-builddir '(directory "test-dangling"
-                                              (("dangling" -> "xxx")))
-      (let ((enter? (lambda (n s r) #t))
-            (leaf   (lambda (n s r) (cons `(leaf ,n) r)))
-            (down   (lambda (n s r) (cons `(down ,n) r)))
-            (up     (lambda (n s r) (cons `(up ,n) r)))
-            (skip   (lambda (n s r) (cons `(skip ,n) r)))
-            (error  (lambda (n s e r) (cons `(error ,n ,e) r)))
-            (name   (string-append %top-builddir "/test-dangling")))
-        (equal? (file-system-fold enter? leaf down up skip error '()
-                                  name)
-                `((up   ,name)
-                  (leaf ,(string-append name "/dangling"))
-                  (down ,name))))))
+    (if (not (defined? 'symlink))
+        'unresolved
+        (with-file-tree %top-builddir '(directory "test-dangling"
+                                                  (("dangling" -> "xxx")))
+          (let ((enter? (lambda (n s r) #t))
+                (leaf   (lambda (n s r) (cons `(leaf ,n) r)))
+                (down   (lambda (n s r) (cons `(down ,n) r)))
+                (up     (lambda (n s r) (cons `(up ,n) r)))
+                (skip   (lambda (n s r) (cons `(skip ,n) r)))
+                (error  (lambda (n s e r) (cons `(error ,n ,e) r)))
+                (name   (string-append %top-builddir "/test-dangling")))
+            (equal? (file-system-fold enter? leaf down up skip error '()
+                                      name)
+                    `((up   ,name)
+                      (leaf ,(string-append name "/dangling"))
+                      (down ,name)))))))
 
   (pass-if "dangling symlink and stat"
-    ;; Same as above, but using `stat' instead of `lstat'.
-    (with-file-tree %top-builddir '(directory "test-dangling"
-                                              (("dangling" -> "xxx")))
-      (let ((enter? (lambda (n s r) #t))
-            (leaf   (lambda (n s r) (cons `(leaf ,n) r)))
-            (down   (lambda (n s r) (cons `(down ,n) r)))
-            (up     (lambda (n s r) (cons `(up ,n) r)))
-            (skip   (lambda (n s r) (cons `(skip ,n) r)))
-            (error  (lambda (n s e r) (cons `(error ,n ,e) r)))
-            (name   (string-append %top-builddir "/test-dangling")))
-        (equal? (file-system-fold enter? leaf down up skip error '()
-                                  name stat)
-                `((up    ,name)
-                  (error ,(string-append name "/dangling") ,ENOENT)
-                  (down  ,name)))))))
+    (if (not (defined? 'symlink))
+        'unresolved
+        ;; Same as above, but using `stat' instead of `lstat'.
+        (with-file-tree %top-builddir '(directory "test-dangling"
+                                                  (("dangling" -> "xxx")))
+          (let ((enter? (lambda (n s r) #t))
+                (leaf   (lambda (n s r) (cons `(leaf ,n) r)))
+                (down   (lambda (n s r) (cons `(down ,n) r)))
+                (up     (lambda (n s r) (cons `(up ,n) r)))
+                (skip   (lambda (n s r) (cons `(skip ,n) r)))
+                (error  (lambda (n s e r) (cons `(error ,n ,e) r)))
+                (name   (string-append %top-builddir "/test-dangling")))
+            (equal? (file-system-fold enter? leaf down up skip error '()
+                                      name stat)
+                    `((up    ,name)
+                      (error ,(string-append name "/dangling") ,ENOENT)
+                      (down  ,name))))))))
 
 (with-test-prefix "file-system-tree"
 
@@ -334,9 +338,10 @@
 
   (pass-if "test-suite"
     (let ((select? (cut string-suffix? ".test" <>)))
-      (match (scandir (string-append %test-dir "/tests") select?)
-        (("00-initial-env.test" (? select?) ...)
-         #t))))
+      (false-if-exception
+       (match (scandir (string-append %test-dir "/tests") select?)
+         (("00-initial-env.test" (? select?) ...)
+          #t)))))
 
   (pass-if "flat file"
     (not (scandir (string-append %test-dir "/Makefile.am"))))
@@ -350,12 +355,14 @@
   ;; In Guile up to 2.0.6, this would return ("." ".." "link-to-dir").
   (pass-if-equal "symlink to directory"
       '("." ".." "link-to-dir" "subdir")
-    (with-file-tree %top-builddir '(directory "test-scandir-symlink"
-                                              (("link-to-dir" -> "subdir")
-                                               (directory "subdir"
-                                                          (("a")))))
-      (let ((name (string-append %top-builddir "/test-scandir-symlink")))
-        (scandir name)))))
+    (if (not (defined? 'symlink))
+        'unresolved
+        (with-file-tree %top-builddir '(directory "test-scandir-symlink"
+                                                  (("link-to-dir" -> "subdir")
+                                                   (directory "subdir"
+                                                              (("a")))))
+          (let ((name (string-append %top-builddir "/test-scandir-symlink")))
+            (scandir name))))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-file-tree 'scheme-indent-function 2)