[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-62-g139ce19

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=139ce194749391487d35fc2681d348a4d6976cef

The branch, stable-2.0 has been updated
       via  139ce194749391487d35fc2681d348a4d6976cef (commit)
       via  f3bb42fc9bc0bac1d8589a9788a93ad4ebbbda3d (commit)
       via  d4eee584e0976e38813d731bb6770f9146f1ef9c (commit)
      from  10744b7c5007ccac19ea9654be6e749fe6a60992 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 139ce194749391487d35fc2681d348a4d6976cef
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 1 00:47:41 2012 +0100

    scandir: Use `lstat' instead of `stat'.
    
    * module/ice-9/ftw.scm (scandir): Use `lstat', not `stat'.
    
    * test-suite/tests/ftw.test ("scandir")["symlink to directory"]: New
      test.

commit f3bb42fc9bc0bac1d8589a9788a93ad4ebbbda3d
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 1 00:43:58 2012 +0100

    test-suite: Use `pass-if-equal' in `ftw.test'.
    
    * test-suite/tests/ftw.test ("file-system-fold")["test-suite (never
      enter)", "test-suite/lib.scm (flat file)"]: Use `pass-if-equal'
      instead of `pass-if'.

commit d4eee584e0976e38813d731bb6770f9146f1ef9c
Author: Ludovic Courtès <address@hidden>
Date:   Thu Nov 1 00:42:37 2012 +0100

    test-suite: Add `pass-if-equal'.
    
    * test-suite/test-suite/lib.scm (pass-if-equal): New macro.
      (run-test): Upon `fail', pass ARGS to REPORT.

-----------------------------------------------------------------------

Summary of changes:
 .dir-locals.el                |    4 +++-
 module/ice-9/ftw.scm          |    2 +-
 test-suite/test-suite/lib.scm |   19 ++++++++++++++++++-
 test-suite/tests/ftw.test     |   38 ++++++++++++++++++++++++--------------
 4 files changed, 46 insertions(+), 17 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index e651538..3640530 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -3,7 +3,9 @@
 ((nil             . ((fill-column . 72)
                      (tab-width   .  8)))
  (c-mode          . ((c-file-style . "gnu")))
- (scheme-mode     . ((indent-tabs-mode . nil)))
+ (scheme-mode
+  . ((indent-tabs-mode . nil)
+     (eval . (put 'pass-if-equal 'scheme-indent-function 2))))
  (emacs-lisp-mode . ((indent-tabs-mode . nil)))
  (texinfo-mode    . ((indent-tabs-mode . nil)
                      (fill-column . 72))))
diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 6c9db27..9c9694f 100644
--- a/module/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -562,7 +562,7 @@ of file names is sorted according to ENTRY<?, which 
defaults to
         result
         (visit (basename name*) result)))
 
-  (and=> (file-system-fold enter? leaf down up skip error #f name stat)
+  (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
          (lambda (files)
            (sort files entry<?))))
 
diff --git a/test-suite/test-suite/lib.scm b/test-suite/test-suite/lib.scm
index 385cdfa..756d97e 100644
--- a/test-suite/test-suite/lib.scm
+++ b/test-suite/test-suite/lib.scm
@@ -44,6 +44,7 @@
  ;; Reporting passes and failures.
  run-test
  pass-if expect-fail
+ pass-if-equal
  pass-if-exception expect-fail-exception
 
  ;; Naming groups of tests in a regular fashion.
@@ -332,7 +333,11 @@
                   ((pass)
                    (report (if expect-pass 'pass 'upass) test-name))
                   ((fail)
-                   (report (if expect-pass 'fail 'xfail) test-name))
+                   ;; ARGS may contain extra info about the failure,
+                   ;; such as the expected and actual value.
+                   (apply report (if expect-pass 'fail 'xfail)
+                          test-name
+                          args))
                   ((unresolved untested unsupported)
                    (report key test-name))
                   ((quit)
@@ -352,6 +357,18 @@
     ((_ name rest ...)
      (run-test name #t (lambda () rest ...)))))
 
+(define-syntax pass-if-equal
+  (syntax-rules ()
+    "Succeed if and only if BODY's return value is equal? to EXPECTED."
+    ((_ name expected body ...)
+     (run-test 'name #t
+               (lambda ()
+                 (let ((result (begin body ...)))
+                   (or (equal? expected result)
+                       (throw 'fail
+                              'expected-value expected
+                              'actual-value result))))))))
+
 ;;; A short form for tests that are expected to fail, taken from Greg.
 (define-syntax expect-fail
   (syntax-rules ()
diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index 33537d0..2a203de 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -182,26 +182,26 @@
               (any (match-lambda (('skip (= basename "vm")) #t) (_ #f))
                    between))))))
 
-  (pass-if "test-suite (never enter)"
+  (pass-if-equal "test-suite (never enter)"
+      `((skip ,%test-dir))
     (let ((enter? (lambda (n s r) #f))
           (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) r))))
-      (equal? (file-system-fold enter? leaf down up skip error '() %test-dir)
-              `((skip , %test-dir)))))
+      (file-system-fold enter? leaf down up skip error '() %test-dir)))
 
-  (pass-if "test-suite/lib.scm (flat file)"
-    (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) r)))
-          (name   (string-append %test-suite-lib-dir "/lib.scm")))
-      (equal? (file-system-fold enter? leaf down up skip error '() name)
-              `((leaf ,name)))))
+  (let ((name   (string-append %test-suite-lib-dir "/lib.scm")))
+    (pass-if-equal "test-suite/lib.scm (flat file)"
+        `((leaf ,name))
+      (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) r))))
+        (file-system-fold enter? leaf down up skip error '() name))))
 
   (pass-if "ENOENT"
     (let ((enter? (lambda (n s r) #t))
@@ -320,7 +320,17 @@
     (not (scandir "/.does-not-exist.")))
 
   (pass-if "no select"
-    (null? (scandir %test-dir (lambda (_) #f)))))
+    (null? (scandir %test-dir (lambda (_) #f))))
+
+  ;; 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)))))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-file-tree 'scheme-indent-function 2)


hooks/post-receive
-- 
GNU Guile