aboutsummaryrefslogtreecommitdiff
path: root/tests/test
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-08-02 02:55:18 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-09-18 22:53:57 +0200
commit23cf6047ae320a1d666ddf6418bade67dfa95ada (patch)
tree1f5897d93efa3ed8de49ce4ebd199b40106f29ea /tests/test
parentExtend module-imports to work on non-module scheme files. (diff)
downloadcalp-23cf6047ae320a1d666ddf6418bade67dfa95ada.tar.gz
calp-23cf6047ae320a1d666ddf6418bade67dfa95ada.tar.xz
Add procedure relative-to.
Diffstat (limited to 'tests/test')
-rw-r--r--tests/test/util.scm25
1 files changed, 25 insertions, 0 deletions
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 1de96a37..ab50898a 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -14,6 +14,7 @@
path-split
file-hidden?
realpath
+ relative-to
filename-extension)))
(test-equal "when"
@@ -295,6 +296,30 @@
(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"))