[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/11: ftw test should handle missing symlink procedure
From: |
Mike Gran |
Subject: |
[Guile-commits] 07/11: ftw test should handle missing symlink procedure |
Date: |
Sun, 24 Jan 2021 01:28:49 -0500 (EST) |
mike121 pushed a commit to branch mingw-guile-3.0
in repository guile.
commit 33addd2b07f802ae8948d74583a9073a371f5ad2
Author: Michael Gran <spk121@yahoo.com>
AuthorDate: 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 4d210dd..d141522 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)
- [Guile-commits] branch mingw-guile-3.0 created (now c8990b7), Mike Gran, 2021/01/24
- [Guile-commits] 01/11: disable popen 'no duplicates' test for MinGW, Mike Gran, 2021/01/24
- [Guile-commits] 03/11: Add Win32 compatibility to JIT, Mike Gran, 2021/01/24
- [Guile-commits] 05/11: ice-9 ftw: handle missing getuid and getgid, Mike Gran, 2021/01/24
- [Guile-commits] 07/11: ftw test should handle missing symlink procedure,
Mike Gran <=
- [Guile-commits] 04/11: On Win32, prefer winsock2 header for socket declarations, Mike Gran, 2021/01/24
- [Guile-commits] 06/11: ice-9 ftw: handle non-working inodes, Mike Gran, 2021/01/24
- [Guile-commits] 08/11: Let read-line handle alternate line endings, Mike Gran, 2021/01/24
- [Guile-commits] 02/11: remove 2nd attempt at invoking ComSpec when spawning child, Mike Gran, 2021/01/24
- [Guile-commits] 09/11: Let suspendable ports' read-line handle alternate line endings, Mike Gran, 2021/01/24
- [Guile-commits] 10/11: simplify reading http headers using updated %read-line, Mike Gran, 2021/01/24
- [Guile-commits] 11/11: For MinGW use Windows filepaths in libpath.h, Mike Gran, 2021/01/24