test-fslib.scm 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332
  1. (use-modules
  2. ;; for unit testing forms
  3. (srfi srfi-64))
  4. (use-modules
  5. ;; import the module to test
  6. (fslib))
  7. (test-begin "fslib-test")
  8. (test-group
  9. "absolute-fsingp-test"
  10. (define fsing-to-current-dir
  11. (dirname (or (current-filename)
  12. (canonicalize-path "."))))
  13. (define non-existing-file-name
  14. "non-existing-file.txt")
  15. ;; absolute fsing existing
  16. (test-assert (absolute-fsing? (absolute-fsing fsing-to-current-dir)))
  17. ;; absolute fsing not existing
  18. (test-assert (absolute-fsing? (absolute-fsing "/a/b/c")))
  19. (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 00"
  20. (not
  21. (absolute-fsing? "../a/b/c")))
  22. (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 01"
  23. (not
  24. (absolute-fsing? "./a/b/c")))
  25. (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 02"
  26. (absolute-fsing? "/a/../b/c"))
  27. (test-assert "absolute-fsing? recognizes relative fsings as not absolute - 03"
  28. (absolute-fsing? "/a/b/./c"))
  29. ;; non-absolute fsing existing
  30. (test-assert (absolute-fsing? (absolute-fsing (current-filename))))
  31. ;; non-absolute fsing not existing
  32. (test-assert (not (file-exists? non-existing-file-name))))
  33. (test-group
  34. "absolute-fsing-test"
  35. (define fsing-to-current-dir
  36. (dirname (or (current-filename)
  37. (canonicalize-path "."))))
  38. (define non-existing-file-name
  39. "non-existing-file.txt")
  40. (simple-format (current-output-port)
  41. "fsing-to-current-dir in tests: ~a\n"
  42. fsing-to-current-dir)
  43. ;; absolute fsing existing
  44. (test-equal fsing-to-current-dir (absolute-fsing fsing-to-current-dir))
  45. ;; absolute fsing not existing
  46. (test-equal "/a/b/c" (absolute-fsing "/a/b/c"))
  47. ;; non-absolute fsing existing
  48. (test-equal "absolute-fsing gives correct absolute fsing for current directory -- 00"
  49. (string-append fsing-to-current-dir
  50. file-name-separator-string
  51. (basename (current-filename)))
  52. (absolute-fsing (current-filename) #:working-directory fsing-to-current-dir))
  53. ;; non-absolute fsing not existing
  54. (test-assert (not (file-exists? non-existing-file-name)))
  55. (test-equal (string-append fsing-to-current-dir
  56. file-name-separator-string
  57. non-existing-file-name)
  58. (absolute-fsing non-existing-file-name #:working-directory fsing-to-current-dir))
  59. (test-equal "absolute-fsing gives correct fsing for non-existing file in directory -- 00"
  60. (fsing-join (dirname fsing-to-current-dir) non-existing-file-name)
  61. (absolute-fsing non-existing-file-name))
  62. (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ../"
  63. (fsing-join (dirname fsing-to-current-dir) ".." "a" "b" "c.txt")
  64. (absolute-fsing "../a/b/c.txt"))
  65. (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ../ and canonicalizes it"
  66. (fsing-join (dirname (dirname fsing-to-current-dir))
  67. "a" "b" "c.txt")
  68. (absolute-fsing "../a/b/c.txt"
  69. #:canonicalize #t))
  70. (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ./"
  71. (fsing-join (dirname fsing-to-current-dir) "." "a" "b" "c.txt")
  72. (absolute-fsing "./a/b/c.txt"))
  73. (test-equal "absolute-fsing is able to deal with non-existing fsing prefixed with ./ and canonicalizes it"
  74. (fsing-join (dirname fsing-to-current-dir) "a" "b" "c.txt")
  75. (absolute-fsing "./a/b/c.txt"
  76. #:canonicalize #t))
  77. (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it"
  78. (fsing-join fsing-to-current-dir
  79. ".." ".." "a" "b" ".." "c" "d." "." ".." "d")
  80. (absolute-fsing "../..//a/b/../c/d././../d"
  81. #:working-directory fsing-to-current-dir))
  82. (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it -- 00"
  83. (fsing-join (dirname (dirname fsing-to-current-dir)) "a" "c" "d")
  84. (absolute-fsing "../..//a/b/../c/d././../d"
  85. #:working-directory fsing-to-current-dir
  86. #:canonicalize #t))
  87. (test-equal "absolute-fsing is able to deal with lots of stuff at once and canonicalizes it -- 01"
  88. (fsing-join (dirname (dirname fsing-to-current-dir)) "a" "c" "d." "e")
  89. (absolute-fsing "../..//a/b/../c/d././e"
  90. #:working-directory fsing-to-current-dir
  91. #:canonicalize #t))
  92. (test-equal "absolute-fsing canonicalizes absolute fsing -- 00"
  93. (fsing-join "/a" "c" "d")
  94. (absolute-fsing "/a/b/../c/d/e/.." #:canonicalize #t))
  95. (test-equal "absolute-fsing canonicalizes absolute fsing -- 01"
  96. (fsing-join "/a" "b")
  97. (absolute-fsing "/a/b/./c/d/e/../../../" #:canonicalize #t)))
  98. (test-group
  99. "fsing-join-test"
  100. (test-equal "fsing-join leaves single separator intact"
  101. file-name-separator-string
  102. (fsing-join file-name-separator-string))
  103. (test-equal "fsing-join of simple parts -- 00"
  104. (string-join '("a" "b" "c") file-name-separator-string)
  105. (fsing-join "a" "b" "c"))
  106. (test-equal "fsing-join leaves initial separator intact -- 00"
  107. "/a/b/c"
  108. (fsing-join file-name-separator-string "a" "b" "c"))
  109. (test-equal "fsing-join ignores empty initial string -- 00"
  110. "a/b/c"
  111. (fsing-join "" "a" "b" "c"))
  112. (test-equal "fsing-join makes fsing separator for intermediate empty string"
  113. "a/b/c"
  114. (fsing-join "" "a" "b" "" "c"))
  115. (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 00"
  116. "/c"
  117. (fsing-join "a" "b" "/c"))
  118. (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 01"
  119. "/b/c"
  120. (fsing-join "" "a" "/b" "c"))
  121. (test-equal "fsing-join restarts fsing when intermediate absolute fsing is found - 02"
  122. "/c"
  123. (fsing-join "" "a" "b" "/c"))
  124. (test-equal "fsing-join can deal with ../ in parts - 00"
  125. "ab/cd/../"
  126. (fsing-join "" "ab" "cd" "../"))
  127. (test-equal "fsing-join can deal with ../ in parts - 01"
  128. "ab/cd/../ef"
  129. (fsing-join "" "ab" "cd" "../" "ef"))
  130. (test-equal "fsing-join can deal with .. in parts - 01"
  131. "ab/cd/.."
  132. (fsing-join "" "ab" "cd" ".."))
  133. (test-equal "fsing-join can deal with .. in parts - 00"
  134. "ab/../ab/cd/ef"
  135. (fsing-join "" "ab" ".." "ab" "cd" "ef"))
  136. (test-equal "fsing-join can deal with . in parts"
  137. "ab/./cd/ef"
  138. (fsing-join "" "ab" "." "cd" "ef"))
  139. (test-equal "fsing-join can deal with multiple / at the end of parts - 00"
  140. ;; The idea is not to add any "/", if a part already ends
  141. ;; in a "/".
  142. "a///b/../c"
  143. (fsing-join "a///" "b" ".." "c"))
  144. (test-equal "fsing-join can deal with multiple / at the end of parts - 01"
  145. "/b/../c"
  146. (fsing-join "a///" "/b" ".." "c")))
  147. (test-group
  148. "file-extension-test"
  149. (test-equal "file-extension gets correct extension for relative fsing"
  150. "txt"
  151. (file-extension "../..//a/b/../c/d././../d/new.txt"))
  152. (test-equal "file-extension gets correct extension for absolute fsing"
  153. "png"
  154. (file-extension "/a/b/../c/d././../d/new.png"))
  155. (test-equal "file-extension gets correct extension for fsing without extension"
  156. #f
  157. (file-extension "/a/b/../c/d././../d/no-extension-here"))
  158. (test-equal "file-extension gets correct extension for fsing with trailing dot"
  159. #f
  160. (file-extension "/a/b/../c/d././../d/no-extension-here.")))
  161. (test-group
  162. "file-name-test"
  163. ;; normal cases for 2 different file extensions
  164. ;; relative
  165. (test-equal "file-name gets correct name - 00"
  166. "myfilename"
  167. (file-name "../d/myfilename.txt"))
  168. (test-equal "file-name gets correct name - 01"
  169. "my-filename2"
  170. (file-name "../d/my-filename2.json"))
  171. ;; absolute
  172. (test-equal "file-name gets correct name - 02"
  173. "myfilename"
  174. (file-name "/../d/myfilename.txt"))
  175. (test-equal "file-name gets correct name - 03"
  176. "myfilename"
  177. (file-name "/../d/myfilename.json"))
  178. ;; files with multiple extensions, 2 and 3 and 4 extensions
  179. ;; relative
  180. (test-equal "file-name gets correct name - 04"
  181. "myfilename.abc"
  182. (file-name "../d/myfilename.abc.txt"))
  183. (test-equal "file-name gets correct name - 05"
  184. "myfilename.abc.txt"
  185. (file-name "../d/myfilename.abc.txt.blablabla"))
  186. (test-equal "file-name gets correct name - 06"
  187. "myfilename.abc.txt.blablabla"
  188. (file-name "../d/myfilename.abc.txt.blablabla.x-y-z"))
  189. ;; absolute
  190. (test-equal "file-name gets correct name - 07"
  191. "myfilename.abc"
  192. (file-name "/../d/myfilename.abc.txt"))
  193. (test-equal "file-name gets correct name - 08"
  194. "myfilename.abc.txt"
  195. (file-name "/../d/myfilename.abc.txt.blablabla"))
  196. (test-equal "file-name gets correct name - 09"
  197. "myfilename.abc.txt.blablabla"
  198. (file-name "/../d/myfilename.abc.txt.blablabla.x-y-z"))
  199. ;; files with only an extension
  200. ;; relative
  201. (test-equal "file-name gets correct name - 10"
  202. #f
  203. (file-name "../d/.txt"))
  204. ;; absolute
  205. (test-equal "file-name gets correct name - 11"
  206. ".txt"
  207. (file-name "../d/.txt.blaaa"))
  208. ;; files with only a name
  209. ;; relative
  210. (test-equal "file-name gets correct name - 12"
  211. "txt"
  212. (file-name "../d/txt"))
  213. ;; absolute
  214. (test-equal "file-name gets correct name - 13"
  215. "txt-json"
  216. (file-name "/../d/txt-json"))
  217. ;; very simple only files no fsing
  218. ;; relative
  219. (test-equal "file-name gets correct name - 14"
  220. "txt"
  221. (file-name "txt"))
  222. ;; absolute
  223. (test-equal "file-name gets correct name - 15"
  224. "txt-json"
  225. (file-name "txt-json")))
  226. (test-group
  227. "sub-fsingp-test"
  228. (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 00"
  229. (sub-fsing? "../..//a/b/../c/d././../d/new.txt" "../..//a/b/../c/d././../d/"))
  230. (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 01"
  231. (sub-fsing? "/a/../a/b/c/e/../d" "/a/b/c/d/"))
  232. (test-assert "sub-fsing? recognizes sub fsing of complex fsing -- 02"
  233. (sub-fsing? "/a/../a/b/c/e/../" "/a/b/c/d/.."))
  234. (test-assert "sub-fsing? recognizes non-sub fsing of complex fsing -- 00"
  235. (sub-fsing? "/a/../a/b/c/e/" "/a/b/c/d/.."))
  236. (test-assert "sub-fsing? recognizes non-sub fsing of complex fsing -- 01"
  237. (sub-fsing? "/a/../a/b/c/" "/a/b/c/d/.."))
  238. (test-assert "sub-fsing? equal fsing is sub-fsing -- 00"
  239. (sub-fsing? "/a/b/c/" "/a/b/c/"))
  240. (test-assert "sub-fsing? equal fsing is sub-fsing -- 01"
  241. (sub-fsing? "/a/../a/b/c/" "/a/b/c/d/.."))
  242. (test-assert "sub-fsing? recognizes non-sub-fsings"
  243. (not (sub-fsing? "/a/b/c/d" "/a/b/d")))
  244. (test-assert "sub-fsing? recognizes non-sub-fsings"
  245. (not (sub-fsing? "/a/b/c/d" "d"))))
  246. ;; Finish the testsuite, and report results.
  247. (test-end "fslib-test")