123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332 |
- (use-modules
- ;; for unit testing forms
- (srfi srfi-64))
- (use-modules
- ;; import the module to test
- (fslib))
- (test-begin "fslib-test")
- (test-group
- "absolute-fsingp-test"
- (define fsing-to-current-dir
- (dirname (or (current-filename)
- (canonicalize-path "."))))
- (define non-existing-file-name
- "non-existing-file.txt")
- ;; absolute fsing existing
- (test-assert (absolute-fsing? (absolute-fsing fsing-to-current-dir)))
- ;; absolute fsing not existing
- (test-assert (absolute-fsing? (absolute-fsing "/a/b/c")))
- (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 00"
- (not
- (absolute-fsing? "../a/b/c")))
- (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 01"
- (not
- (absolute-fsing? "./a/b/c")))
- (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 02"
- (absolute-fsing? "/a/../b/c"))
- (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 03"
- (absolute-fsing? "/a/b/./c"))
- ;; non-absolute fsing existing
- (test-assert (absolute-fsing? (absolute-fsing (current-filename))))
- ;; non-absolute fsing not existing
- (test-assert (not (file-exists? non-existing-file-name))))
- (test-group
- "absolute-fsing-test"
- (define fsing-to-current-dir
- (dirname (or (current-filename)
- (canonicalize-path "."))))
- (define non-existing-file-name
- "non-existing-file.txt")
- (simple-format (current-output-port)
- "fsing-to-current-dir in tests: ~a\n"
- fsing-to-current-dir)
- ;; absolute fsing existing
- (test-equal fsing-to-current-dir (absolute-fsing fsing-to-current-dir))
- ;; absolute fsing not existing
- (test-equal "/a/b/c" (absolute-fsing "/a/b/c"))
- ;; non-absolute fsing existing
- (test-equal "absolute-fsing gives correct absolute fsing for current directory -- 00"
- (string-append fsing-to-current-dir
- file-name-separator-string
- (basename (current-filename)))
- (absolute-fsing (current-filename) #:working-directory fsing-to-current-dir))
- ;; non-absolute fsing not existing
- (test-assert (not (file-exists? non-existing-file-name)))
- (test-equal (string-append fsing-to-current-dir
- file-name-separator-string
- non-existing-file-name)
- (absolute-fsing non-existing-file-name #:working-directory fsing-to-current-dir))
- (test-equal "absolute-fsing gives correct fsing for non-existing file in directory -- 00"
- (fsing-join (dirname fsing-to-current-dir) non-existing-file-name)
- (absolute-fsing non-existing-file-name))
- (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ../"
- (fsing-join (dirname fsing-to-current-dir) ".." "a" "b" "c.txt")
- (absolute-fsing "../a/b/c.txt"))
- (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ../ and canonicalizes it"
- (fsing-join (dirname (dirname fsing-to-current-dir))
- "a" "b" "c.txt")
- (absolute-fsing "../a/b/c.txt"
- #:canonicalize #t))
- (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ./"
- (fsing-join (dirname fsing-to-current-dir) "." "a" "b" "c.txt")
- (absolute-fsing "./a/b/c.txt"))
- (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ./ and canonicalizes it"
- (fsing-join (dirname fsing-to-current-dir) "a" "b" "c.txt")
- (absolute-fsing "./a/b/c.txt"
- #:canonicalize #t))
- (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it"
- (fsing-join fsing-to-current-dir
- ".." ".." "a" "b" ".." "c" "d." "." ".." "d")
- (absolute-fsing "../..//a/b/../c/d././../d"
- #:working-directory fsing-to-current-dir))
- (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it -- 00"
- (fsing-join (dirname (dirname fsing-to-current-dir)) "a" "c" "d")
- (absolute-fsing "../..//a/b/../c/d././../d"
- #:working-directory fsing-to-current-dir
- #:canonicalize #t))
- (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it -- 01"
- (fsing-join (dirname (dirname fsing-to-current-dir)) "a" "c" "d." "e")
- (absolute-fsing "../..//a/b/../c/d././e"
- #:working-directory fsing-to-current-dir
- #:canonicalize #t))
- (test-equal "absolute-fsing canonicalizes absolute fsing -- 00"
- (fsing-join "/a" "c" "d")
- (absolute-fsing "/a/b/../c/d/e/.." #:canonicalize #t))
- (test-equal "absolute-fsing canonicalizes absolute fsing -- 01"
- (fsing-join "/a" "b")
- (absolute-fsing "/a/b/./c/d/e/../../../" #:canonicalize #t)))
- (test-group
- "fsing-join-test"
- (test-equal "fsing-join leaves single separator intact"
- file-name-separator-string
- (fsing-join file-name-separator-string))
- (test-equal "fsing-join of simple parts -- 00"
- (string-join '("a" "b" "c") file-name-separator-string)
- (fsing-join "a" "b" "c"))
- (test-equal "fsing-join leaves initial separator intact -- 00"
- "/a/b/c"
- (fsing-join file-name-separator-string "a" "b" "c"))
- (test-equal "fsing-join ignores empty initial string -- 00"
- "a/b/c"
- (fsing-join "" "a" "b" "c"))
- (test-equal "fsing-join makes fsing separator for intermediate empty string"
- "a/b/c"
- (fsing-join "" "a" "b" "" "c"))
- (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 00"
- "/c"
- (fsing-join "a" "b" "/c"))
- (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 01"
- "/b/c"
- (fsing-join "" "a" "/b" "c"))
- (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 02"
- "/c"
- (fsing-join "" "a" "b" "/c"))
- (test-equal "fsing-join can deal with ../ in parts - 00"
- "ab/cd/../"
- (fsing-join "" "ab" "cd" "../"))
- (test-equal "fsing-join can deal with ../ in parts - 01"
- "ab/cd/../ef"
- (fsing-join "" "ab" "cd" "../" "ef"))
- (test-equal "fsing-join can deal with .. in parts - 01"
- "ab/cd/.."
- (fsing-join "" "ab" "cd" ".."))
- (test-equal "fsing-join can deal with .. in parts - 00"
- "ab/../ab/cd/ef"
- (fsing-join "" "ab" ".." "ab" "cd" "ef"))
- (test-equal "fsing-join can deal with . in parts"
- "ab/./cd/ef"
- (fsing-join "" "ab" "." "cd" "ef"))
- (test-equal "fsing-join can deal with multiple / at the end of parts - 00"
- ;; The idea is not to add any "/", if a part already ends
- ;; in a "/".
- "a///b/../c"
- (fsing-join "a///" "b" ".." "c"))
- (test-equal "fsing-join can deal with multiple / at the end of parts - 01"
- "/b/../c"
- (fsing-join "a///" "/b" ".." "c")))
- (test-group
- "file-extension-test"
- (test-equal "file-extension gets correct extension for relative fsing"
- "txt"
- (file-extension "../..//a/b/../c/d././../d/new.txt"))
- (test-equal "file-extension gets correct extension for absolute fsing"
- "png"
- (file-extension "/a/b/../c/d././../d/new.png"))
- (test-equal "file-extension gets correct extension for fsing without extension"
- #f
- (file-extension "/a/b/../c/d././../d/no-extension-here"))
- (test-equal "file-extension gets correct extension for fsing with trailing dot"
- #f
- (file-extension "/a/b/../c/d././../d/no-extension-here.")))
- (test-group
- "file-name-test"
- ;; normal cases for 2 different file extensions
- ;; relative
- (test-equal "file-name gets correct name - 00"
- "myfilename"
- (file-name "../d/myfilename.txt"))
- (test-equal "file-name gets correct name - 01"
- "my-filename2"
- (file-name "../d/my-filename2.json"))
- ;; absolute
- (test-equal "file-name gets correct name - 02"
- "myfilename"
- (file-name "/../d/myfilename.txt"))
- (test-equal "file-name gets correct name - 03"
- "myfilename"
- (file-name "/../d/myfilename.json"))
- ;; files with multiple extensions, 2 and 3 and 4 extensions
- ;; relative
- (test-equal "file-name gets correct name - 04"
- "myfilename.abc"
- (file-name "../d/myfilename.abc.txt"))
- (test-equal "file-name gets correct name - 05"
- "myfilename.abc.txt"
- (file-name "../d/myfilename.abc.txt.blablabla"))
- (test-equal "file-name gets correct name - 06"
- "myfilename.abc.txt.blablabla"
- (file-name "../d/myfilename.abc.txt.blablabla.x-y-z"))
- ;; absolute
- (test-equal "file-name gets correct name - 07"
- "myfilename.abc"
- (file-name "/../d/myfilename.abc.txt"))
- (test-equal "file-name gets correct name - 08"
- "myfilename.abc.txt"
- (file-name "/../d/myfilename.abc.txt.blablabla"))
- (test-equal "file-name gets correct name - 09"
- "myfilename.abc.txt.blablabla"
- (file-name "/../d/myfilename.abc.txt.blablabla.x-y-z"))
- ;; files with only an extension
- ;; relative
- (test-equal "file-name gets correct name - 10"
- #f
- (file-name "../d/.txt"))
- ;; absolute
- (test-equal "file-name gets correct name - 11"
- ".txt"
- (file-name "../d/.txt.blaaa"))
- ;; files with only a name
- ;; relative
- (test-equal "file-name gets correct name - 12"
- "txt"
- (file-name "../d/txt"))
- ;; absolute
- (test-equal "file-name gets correct name - 13"
- "txt-json"
- (file-name "/../d/txt-json"))
- ;; very simple only files no fsing
- ;; relative
- (test-equal "file-name gets correct name - 14"
- "txt"
- (file-name "txt"))
- ;; absolute
- (test-equal "file-name gets correct name - 15"
- "txt-json"
- (file-name "txt-json")))
- (test-group
- "sub-fsingp-test"
- (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 00"
- (sub-fsing? "../..//a/b/../c/d././../d/new.txt" "../..//a/b/../c/d././../d/"))
- (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 01"
- (sub-fsing? "/a/../a/b/c/e/../d" "/a/b/c/d/"))
- (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 02"
- (sub-fsing? "/a/../a/b/c/e/../" "/a/b/c/d/.."))
- (test-assert "sub-fsing? recognizes non-sub fsing of complex fsing -- 00"
- (sub-fsing? "/a/../a/b/c/e/" "/a/b/c/d/.."))
- (test-assert "sub-fsing? recognizes non-sub fsing of complex fsing -- 01"
- (sub-fsing? "/a/../a/b/c/" "/a/b/c/d/.."))
- (test-assert "sub-fsing? equal fsing is sub-fsing -- 00"
- (sub-fsing? "/a/b/c/" "/a/b/c/"))
- (test-assert "sub-fsing? equal fsing is sub-fsing -- 01"
- (sub-fsing? "/a/../a/b/c/" "/a/b/c/d/.."))
- (test-assert "sub-fsing? recognizes non-sub-fsings"
- (not (sub-fsing? "/a/b/c/d" "/a/b/d")))
- (test-assert "sub-fsing? recognizes non-sub-fsings"
- (not (sub-fsing? "/a/b/c/d" "d"))))
- ;; Finish the testsuite, and report results.
- (test-end "fslib-test")
|