mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 05:50:26 +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)))))) (file-system-fold enter? leaf down up skip error '() name))))))
(pass-if "dangling symlink and lstat" (pass-if "dangling symlink and lstat"
(with-file-tree %top-builddir '(directory "test-dangling" (if (not (defined? 'symlink))
(("dangling" -> "xxx"))) (throw 'unresolved)
(let ((enter? (lambda (n s r) #t)) (with-file-tree %top-builddir '(directory "test-dangling"
(leaf (lambda (n s r) (cons `(leaf ,n) r))) (("dangling" -> "xxx")))
(down (lambda (n s r) (cons `(down ,n) r))) (let ((enter? (lambda (n s r) #t))
(up (lambda (n s r) (cons `(up ,n) r))) (leaf (lambda (n s r) (cons `(leaf ,n) r)))
(skip (lambda (n s r) (cons `(skip ,n) r))) (down (lambda (n s r) (cons `(down ,n) r)))
(error (lambda (n s e r) (cons `(error ,n ,e) r))) (up (lambda (n s r) (cons `(up ,n) r)))
(name (string-append %top-builddir "/test-dangling"))) (skip (lambda (n s r) (cons `(skip ,n) r)))
(equal? (file-system-fold enter? leaf down up skip error '() (error (lambda (n s e r) (cons `(error ,n ,e) r)))
name) (name (string-append %top-builddir "/test-dangling")))
`((up ,name) (equal? (file-system-fold enter? leaf down up skip error '()
(leaf ,(string-append name "/dangling")) name)
(down ,name)))))) `((up ,name)
(leaf ,(string-append name "/dangling"))
(down ,name)))))))
(pass-if "dangling symlink and stat" (pass-if "dangling symlink and stat"
;; Same as above, but using `stat' instead of `lstat'. ;; Same as above, but using `stat' instead of `lstat'.
(with-file-tree %top-builddir '(directory "test-dangling" (if (not (defined? 'symlink))
(("dangling" -> "xxx"))) (throw 'unresolved)
(let ((enter? (lambda (n s r) #t)) (with-file-tree %top-builddir '(directory "test-dangling"
(leaf (lambda (n s r) (cons `(leaf ,n) r))) (("dangling" -> "xxx")))
(down (lambda (n s r) (cons `(down ,n) r))) (let ((enter? (lambda (n s r) #t))
(up (lambda (n s r) (cons `(up ,n) r))) (leaf (lambda (n s r) (cons `(leaf ,n) r)))
(skip (lambda (n s r) (cons `(skip ,n) r))) (down (lambda (n s r) (cons `(down ,n) r)))
(error (lambda (n s e r) (cons `(error ,n ,e) r))) (up (lambda (n s r) (cons `(up ,n) r)))
(name (string-append %top-builddir "/test-dangling"))) (skip (lambda (n s r) (cons `(skip ,n) r)))
(equal? (file-system-fold enter? leaf down up skip error '() (error (lambda (n s e r) (cons `(error ,n ,e) r)))
name stat) (name (string-append %top-builddir "/test-dangling")))
`((up ,name) (equal? (file-system-fold enter? leaf down up skip error '()
(error ,(string-append name "/dangling") ,ENOENT) name stat)
(down ,name))))))) `((up ,name)
(error ,(string-append name "/dangling") ,ENOENT)
(down ,name))))))))
(with-test-prefix "file-system-tree" (with-test-prefix "file-system-tree"
@ -350,12 +354,14 @@
;; In Guile up to 2.0.6, this would return ("." ".." "link-to-dir"). ;; In Guile up to 2.0.6, this would return ("." ".." "link-to-dir").
(pass-if-equal "symlink to directory" (pass-if-equal "symlink to directory"
'("." ".." "link-to-dir" "subdir") '("." ".." "link-to-dir" "subdir")
(with-file-tree %top-builddir '(directory "test-scandir-symlink" (if (not (defined? 'symlink))
(("link-to-dir" -> "subdir") (throw 'unresolved)
(directory "subdir" (with-file-tree %top-builddir '(directory "test-scandir-symlink"
(("a"))))) (("link-to-dir" -> "subdir")
(let ((name (string-append %top-builddir "/test-scandir-symlink"))) (directory "subdir"
(scandir name))))) (("a")))))
(let ((name (string-append %top-builddir "/test-scandir-symlink")))
(scandir name))))))
;;; Local Variables: ;;; Local Variables:
;;; eval: (put 'with-file-tree 'scheme-indent-function 2) ;;; eval: (put 'with-file-tree 'scheme-indent-function 2)