From 23cf6047ae320a1d666ddf6418bade67dfa95ada Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 2 Aug 2022 02:55:18 +0200 Subject: Add procedure relative-to. --- tests/test/util.scm | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'tests/test') 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")) -- cgit v1.2.3