diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-08-02 02:55:18 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-09-18 22:53:57 +0200 |
commit | 23cf6047ae320a1d666ddf6418bade67dfa95ada (patch) | |
tree | 1f5897d93efa3ed8de49ce4ebd199b40106f29ea /tests/test/util.scm | |
parent | Extend module-imports to work on non-module scheme files. (diff) | |
download | calp-23cf6047ae320a1d666ddf6418bade67dfa95ada.tar.gz calp-23cf6047ae320a1d666ddf6418bade67dfa95ada.tar.xz |
Add procedure relative-to.
Diffstat (limited to '')
-rw-r--r-- | tests/test/util.scm | 25 |
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")) |