mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 21:40:33 +02:00
in ftw test, don't presume symlink is defined
* test-suite/tests/ftw.test (dangling symlink and lstat) (dangling symlink and stat, symlink to directory): skip if symlink undefined
This commit is contained in:
parent
130463be2a
commit
775149f0f5
1 changed files with 40 additions and 34 deletions
|
@ -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))
|
||||
(throw '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))
|
||||
(throw '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 stat)
|
||||
`((up ,name)
|
||||
(error ,(string-append name "/dangling") ,ENOENT)
|
||||
(down ,name))))))))
|
||||
|
||||
(with-test-prefix "file-system-tree"
|
||||
|
||||
|
@ -350,12 +354,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))
|
||||
(throw '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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue