mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 04:15:36 +02:00
Code Activity

ice-9 ftw: handle non-working inodes

Browse source 
* module/ice-9/ftw.scm (visited?-proc): accept filename for string hash
  (file-system-fold): use string hash if ino = 0
  (ftw): use new visited?-proc
* test-suite/tests/ftw.test (visited?-proc valid inodes): add filenames to visited?-proc calls
  (visited?-proc broken inodes): new tests
  (%top-srcdir): canonicalize-path
This commit is contained in:
Michael Gran 2018-04-16 20:57:12 -07:00
parent c150044640
commit a744f98dcc
2 changed files with 66 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -53,28 +53,49 @@
(visited? (visited?-proc 97))
(s (stat "/")))
(define (try-visited? dev ino)
(define (try-visited? dev ino fname)
(stat:dev! s dev)
(stat:ino! s ino)
(visited? s))
(visited? s fname))
(pass-if "0 0 - 1st" (eq? #f (try-visited? 0 0)))
(pass-if "0 0 - 2nd" (eq? #t (try-visited? 0 0)))
(pass-if "0 0 - 3rd" (eq? #t (try-visited? 0 0)))
(with-test-prefix "valid inodes"
(pass-if "0 1" (eq? #f (try-visited? 0 1)))
(pass-if "0 2" (eq? #f (try-visited? 0 2)))
(pass-if "0 3" (eq? #f (try-visited? 0 3)))
(pass-if "0 1 - 1st" (eq? #f (try-visited? 0 1 "0.1")))
(pass-if "0 1 - 2nd" (eq? #t (try-visited? 0 1 "0.1")))
(pass-if "0 1 - 3rd" (eq? #t (try-visited? 0 1 "0.1")))
(pass-if "5 5" (eq? #f (try-visited? 5 5)))
(pass-if "5 7" (eq? #f (try-visited? 5 7)))
(pass-if "7 5" (eq? #f (try-visited? 7 5)))
(pass-if "7 7" (eq? #f (try-visited? 7 7)))
(pass-if "0 2" (eq? #f (try-visited? 0 2 "0.2")))
(pass-if "0 3" (eq? #f (try-visited? 0 3 "0.3")))
(pass-if "0 4" (eq? #f (try-visited? 0 4 "0.4")))
(pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 5)))
(pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 7)))
(pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 5)))
(pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 7)))))
(pass-if "5 5" (eq? #f (try-visited? 5 5 "5.5")))
(pass-if "5 7" (eq? #f (try-visited? 5 7 "5.7")))
(pass-if "7 5" (eq? #f (try-visited? 7 5 "7.5")))
(pass-if "7 7" (eq? #f (try-visited? 7 7 "7.7")))
(pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 5 "5.5")))
(pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 7 "5.7")))
(pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 5 "7.5")))
(pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 7 "7.7"))))
(with-test-prefix "broken inodes"
(pass-if "0 1 - 1st" (eq? #f (try-visited? 0 0 "0.1")))
(pass-if "0 1 - 2nd" (eq? #t (try-visited? 0 0 "0.1")))
(pass-if "0 1 - 3rd" (eq? #t (try-visited? 0 0 "0.1")))
(pass-if "0 2" (eq? #f (try-visited? 0 0 "0.2")))
(pass-if "0 3" (eq? #f (try-visited? 0 0 "0.3")))
(pass-if "0 4" (eq? #f (try-visited? 0 0 "0.4")))
(pass-if "5 5" (eq? #f (try-visited? 5 0 "5.5")))
(pass-if "5 7" (eq? #f (try-visited? 5 0 "5.7")))
(pass-if "7 5" (eq? #f (try-visited? 7 0 "7.5")))
(pass-if "7 7" (eq? #f (try-visited? 7 0 "7.7")))
(pass-if "5 5 - 2nd" (eq? #t (try-visited? 5 0 "5.5")))
(pass-if "5 7 - 2nd" (eq? #t (try-visited? 5 0 "5.7")))
(pass-if "7 5 - 2nd" (eq? #t (try-visited? 7 0 "7.5")))
(pass-if "7 7 - 2nd" (eq? #t (try-visited? 7 0 "7.7"))))))
;;;
@ -85,7 +106,7 @@
(canonicalize-path (getcwd)))
(define %top-srcdir
(assq-ref %guile-build-info 'top_srcdir))
(canonicalize-path (assq-ref %guile-build-info 'top_srcdir)))
(define %test-dir
(string-append %top-srcdir "/test-suite"))