aboutsummaryrefslogtreecommitdiff
path: root/tests/test/hnh-util-path.scm
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-04-04 14:39:29 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2023-04-10 23:45:29 +0200
commitfc6759c3596b695634466330e37baa4d16222b0c (patch)
tree1e2b0ea4715ebe7afa3d0a8cf5ba95a223f24a77 /tests/test/hnh-util-path.scm
parentBorrow state-monad from guile-dns. (diff)
downloadcalp-fc6759c3596b695634466330e37baa4d16222b0c.tar.gz
calp-fc6759c3596b695634466330e37baa4d16222b0c.tar.xz
Reorder (util .*) tests.
Added test groups for each exported procedure (meaning that the TODOs are now updated (at least for (hnh util))). Split path tests out into own file. Also rename those files so they map 1-1 onto their core module names.
Diffstat (limited to 'tests/test/hnh-util-path.scm')
-rw-r--r--tests/test/hnh-util-path.scm124
1 files changed, 124 insertions, 0 deletions
diff --git a/tests/test/hnh-util-path.scm b/tests/test/hnh-util-path.scm
new file mode 100644
index 00000000..de4bf8e3
--- /dev/null
+++ b/tests/test/hnh-util-path.scm
@@ -0,0 +1,124 @@
+(define-module (test hnh-util-path)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-64 test-error)
+ :use-module (srfi srfi-88)
+ :use-module ((hnh util env) :select (with-working-directory))
+ :use-module (hnh util path))
+
+(test-equal
+ "no slashes"
+ "home/user"
+ (path-append "home" "user"))
+
+(test-equal
+ "no slashes, absolute"
+ "/home/user"
+ (path-append "" "home" "user"))
+
+(test-equal
+ "slashes in one component, absolute"
+ "/home/user"
+ (path-append "" "/home/" "user"))
+
+(test-equal
+ "slashes in one component, absolute due to first"
+ "/home/user"
+ (path-append "/home/" "user"))
+
+(test-equal
+ "Slashes in both"
+ "home/user"
+ (path-append "home/" "/user"))
+
+(test-equal "root" "/" (path-append ""))
+
+(test-equal
+ '("usr" "lib" "test")
+ (path-split "usr/lib/test"))
+
+(test-equal
+ '("usr" "lib" "test")
+ (path-split "usr/lib/test/"))
+
+(test-equal
+ '("" "usr" "lib" "test")
+ (path-split "/usr/lib/test"))
+
+(test-equal
+ '("" "usr" "lib" "test")
+ (path-split "//usr////lib/test"))
+
+(test-assert (file-hidden? ".just-filename"))
+(test-assert (file-hidden? "/path/to/.hidden"))
+(test-assert (not (file-hidden? "/visible/.in/hidden")))
+(test-assert (not (file-hidden? "")))
+
+;; TODO test realpath with .. and similar
+
+(test-equal "Realpath for path fragment"
+ "/home/hugo"
+ (with-working-directory
+ "/home"
+ (lambda () (realpath "hugo"))))
+
+(test-equal "Realpath for already absolute path"
+ "/home/hugo"
+ (with-working-directory
+ "/tmp"
+ (lambda () (realpath "/home/hugo"))))
+
+(test-equal "Realpath for already absolute path"
+ "/home/hugo"
+ (with-working-directory
+ "/tmp"
+ (lambda () (realpath "/home/hugo"))))
+
+
+(test-group "Relative to"
+
+ (test-group "With relative child"
+ (test-equal "/some/path" (relative-to "/some" "path")))
+
+ ;; Relative parent just adds (getcwd) to start of parent,
+ ;; but this is "hard" to test.
+ ;; (test-group "With relative parent")
+
+ (test-group "With absolute child"
+ (test-error 'misc-error (relative-to "" "/some/path"))
+ (test-equal "some/path" (relative-to "/" "/some/path"))
+ (test-group "Without trailing slashes"
+ (test-equal "path" (relative-to "/some" "/some/path"))
+ (test-equal "../path" (relative-to "/some" "/other/path")))
+ (test-group "With trailing slashes"
+ (test-equal "path" (relative-to "/some" "/some/path/"))
+ (test-equal "../path" (relative-to "/some" "/other/path/"))))
+
+ (test-equal "/a/b" (relative-to "/a/b/c" "/a/b"))
+
+ )
+
+
+(test-equal "Extension of simple file"
+ "txt" (filename-extension "file.txt"))
+
+(test-equal "Extension of file with directory"
+ "txt" (filename-extension "/direcotry/file.txt"))
+
+(test-equal "Extension of file with multiple"
+ "gz" (filename-extension "filename.tar.gz"))
+
+(test-equal "Filename extension when none is present"
+ "" (filename-extension "filename"))
+
+(test-equal "Filename extension when none is present, but directory has"
+ "" (filename-extension "config.d/filename"))
+
+(test-equal "Filename extension of directory"
+ "d" (filename-extension "config.d/"))
+
+
+(test-equal "Extension of hidden file"
+ "sh" (filename-extension ".bashrc.sh"))
+
+(test-equal "Extension of hidden file without extension"
+ "bashrc" (filename-extension ".bashrc"))