mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-29 22:40:34 +02:00
Code Activity

in ftw test, don't presume symlink is defined

Browse source 
* 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:
Mike Gran 2022-09-20 19:30:38 -07:00
parent 130463be2a
commit 775149f0f5
1 changed files with 40 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

74
test-suite/tests/ftw.test
View file

@ -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)