diff options
Diffstat (limited to 'tests/test')
-rw-r--r-- | tests/test/hnh-util-env.scm | 47 | ||||
-rw-r--r-- | tests/test/hnh-util-path.scm | 124 | ||||
-rw-r--r-- | tests/test/hnh-util.scm | 357 | ||||
-rw-r--r-- | tests/test/let-env.scm | 43 | ||||
-rw-r--r-- | tests/test/util.scm | 375 |
5 files changed, 528 insertions, 418 deletions
diff --git a/tests/test/hnh-util-env.scm b/tests/test/hnh-util-env.scm new file mode 100644 index 00000000..93f72bc9 --- /dev/null +++ b/tests/test/hnh-util-env.scm @@ -0,0 +1,47 @@ +(define-module (test hnh-util-env) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module ((guile) :select (setenv getenv)) + :use-module ((hnh util env) :select (let-env))) + + +(test-group "let-env" + (setenv "CALP_TEST_ENV" "1") + + (test-equal + "Ensure we have set value beforehand" + "1" + (getenv "CALP_TEST_ENV")) + + (let-env + ((CALP_TEST_ENV "2")) + (test-equal + "Test our local override" + "2" + (getenv "CALP_TEST_ENV"))) + + (test-equal + "Test that we have returned" + "1" + (getenv "CALP_TEST_ENV")) + + (catch 'test-error + (lambda () + (let-env + ((CALP_TEST_ENV "2")) + (test-equal + "Test our local override again" + "2" + (getenv "CALP_TEST_ENV")) + (throw 'test-error))) + list) + + (test-equal + "Test restoration after non-local exit" + "1" + (getenv "CALP_TEST_ENV"))) + +(test-group "with-working-directory" + 'TODO) + 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")) diff --git a/tests/test/hnh-util.scm b/tests/test/hnh-util.scm new file mode 100644 index 00000000..72b3c60e --- /dev/null +++ b/tests/test/hnh-util.scm @@ -0,0 +1,357 @@ +;;; Commentary: +;; Checks some prodecuders from (hnh util) +;;; Code: + +(define-module (test hnh-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (srfi srfi-1) + :use-module (hnh util) + :use-module (hnh util env) + ) + + +;;; Changed core bindings + +(test-group "set!" + 'TODO) + +(test-group "define-syntax" + 'TODO) + +(test-group "when" + (test-equal "when" + 1 (when #t 1)) + + (test-equal "'() when #f" + '() (when #f 1))) + +(test-group "unless" + (test-equal "unless" + 1 (unless #f 1)) + + (test-equal "'() unless #t" + '() (unless #t 1))) + + + +;;; New bindings + +(test-group "aif" + 'TODO) + +(test-group "awhen" + (test-equal "awhen it" + '(3 4 5) + (awhen (memv 2 '(1 2 3 4 5)) + (cdr it))) + + (test-equal "awhen not" + '() + (awhen (memv 0 '(1 2 3 4 5)) + (cdr it)))) + +(test-group "for" + (test-equal "for simple" + (iota 10) + (for x in (iota 10) + x)) + + (test-equal "for matching" + (iota 12) + (for (x c) in (zip (iota 12) (string->list "Hello, World")) + x)) + + (test-equal "for with improper list elements" + `(3 7) + (for (a . b) in '((1 . 2) (3 . 4)) + (+ a b))) + + (test-equal "for with longer improper list elements" + '(1 2 4) + (for (a b . c) in '((1 -1 . 1) (2 -2 . 2) (4 -4 . 4)) + (* c (+ 1 a b))))) + +(test-group "begin1" + (let ((value #f)) + (test-equal + "begin1 return value" + "Hello" + (begin1 "Hello" (set! value "World"))) + (test-equal "begin1 side effects" "World" value)) + + (let ((x 1)) + (test-eqv "begin1 set! after return" + 1 (begin1 x (set! x 10))) + (test-eqv "Updates value" + 10 x))) + +(test-group "print-and-return" + 'TODO) + +(test-group "swap" + 'TODO) + +(test-group "set/r!" + (test-equal + "set/r! = single" + #f + (let ((x #t)) (set/r! x = not))) + + (test-error + 'syntax-error + (test-read-eval-string "(set/r! x err not)"))) + +(test-group "label" + (test-equal "procedure label" + 120 + ((label factorial (lambda (n) + (if (zero? n) + 1 (* n (factorial (1- n)))))) + 5))) + +(test-group "sort*" + ;; we can't test if sort*! destroys the list, since its only /allowed/ to do it, + ;; not required. + (test-equal "sort*!" + '("a" "Hello" "Assparagus") + (sort*! '("Hello" "a" "Assparagus") + < string-length))) + + +(test-group "find-extreme" + (test-error 'wrong-type-arg (find-extreme '())) + + (test-group "find-min" + (call-with-values + (lambda () (find-min (iota 10))) + (lambda (extreme rest) + (test-equal "Found correct minimum" 0 extreme) + (test-equal + "Removed \"something\" from the set" + 9 + (length rest))))) + + (test-group "find-max" + (call-with-values + (lambda () + (find-max + '("Hello" "Test" "Something long") + string-length)) + (lambda (extreme rest) + (test-equal + "Found the longest string" + "Something long" + extreme) + (test-equal "Removed the string" 2 (length rest)) + (test-assert + "Other members left 1" + (member "Hello" rest)) + (test-assert + "Other members left 2" + (member "Test" rest)))))) + +(test-group "filter-sorted" + (test-equal + "Filter sorted" + '(3 4 5) + (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10)))) + + +(test-group "!=" + (test-assert "not equal" + (!= 1 2))) + + +(test-group "take-to" + (test-equal "Take to" + '() (take-to '() 5))) + +(test-group "string-take-to" + 'TODO) + +(test-group "string-first" + 'TODO) + +(test-group "string-last" + 'TODO) + +(test-group "as-symb" + 'TODO) + + +(test-group "enumerate" + (test-equal "Enumerate" + '((0 #\H) (1 #\e) (2 #\l) (3 #\l) (4 #\o) (5 #\,) (6 #\space) (7 #\W) (8 #\o) (9 #\r) (10 #\l) (11 #\d) (12 #\!)) + (enumerate (string->list "Hello, World!")))) + + +(test-group "unval" + (test-equal "unval first" + 1 + ((unval (lambda () (values 1 2 3))))) + + (test-equal "unval other" + 2 + ((unval car+cdr 1) + (cons 1 2)))) + + +(test-group "flatten" + (test-equal "flatten already flat" + (iota 10) + (flatten (iota 10))) + + (test-equal "flatten really deep" + '(1) + (flatten '(((((((((((((((1))))))))))))))))) + + (test-equal "flatten mixed" + '(1 2 3 4 5) + (flatten '((((((1(((((2((((3))))))4))))))))5)))) + +(test-group "let-lazy" + 'TODO) + +(test-group "map/dotted" + (test-equal "map/dotted without dot" + '(1 2 3 4) + (map/dotted 1+ '(0 1 2 3))) + + (test-equal "map/dotted with dot" + '(1 2 3 . 4) + (map/dotted 1+ '(0 1 2 . 3))) + + (test-equal "map/dotted direct value" + 1 (map/dotted 1+ 0))) + +(test-group "assq-merge" + (test-equal "assq merge" + '((k 2 1) (v 2)) + (assq-merge '((k 1) (v 2)) '((k 2))))) + + +(test-group "kvlist->assq" + (test-equal "kvlist->assq" + '((a . 1) (b . 2)) + (kvlist->assq '(a: 1 b: 2))) + + (test-equal "kvlist->assq repeated key" + '((a . 1) (b . 2) (a . 3)) + (kvlist->assq '(a: 1 b: 2 a: 3)))) + +(test-group "assq-limit" + 'TODO) + + +(test-group "group-by" + ;; Extra roundabout tests since groups-by doesn't guarantee order of the keys + (test-group "Two simple groups" + (let ((groups (group-by even? (iota 10)))) + (test-assert (lset= eq? '(#f #t) (map car groups))) + (test-assert (lset= = '(0 2 4 6 8) (assq-ref groups #t))) + (test-assert (lset= = '(1 3 5 7 9) (assq-ref groups #f))))) + + (test-group "Identity groups" + (let ((groups (group-by identity (iota 5)))) + (test-assert "Correct keys" + (lset= = (iota 5) (map car groups))) + (test-group "Correct amount in each group" + (for-each (lambda (g) (test-equal 1 (length (cdr g)))) groups)))) + + (test-equal "Null case" + '() + (group-by (lambda _ (/ 0)) '()))) + +(test-group "split-by" + 'TODO) + + +(test-group "span-upto" + (test-group "Case 1" + (call-with-values + (lambda () + (span-upto + 2 + char-numeric? + (string->list "123456"))) + (lambda (head tail) + (test-equal '(#\1 #\2) head) + (test-equal '(#\3 #\4 #\5 #\6) tail)))) + + (test-group "Case 2" + (call-with-values + (lambda () + (span-upto + 2 + char-numeric? + (string->list "H123456"))) + (lambda (head tail) + (test-equal '() head) + (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))))) + +(test-group "cross-product" + 'TODO) + +(test-group "string-flatten" + 'TODO) + +(test-group "intersperse" + 'TODO) + +(test-group "insert-ordered" + 'TODO) + +(test-group "-> (arrows)" + (test-equal "->" 9 (-> 1 (+ 2) (* 3))) + (test-equal "-> order dependant" -1 (-> 1 (- 2))) + (test-equal "->> order dependant" 1 (->> 1 (- 2)))) + +(test-group "set" + 'TODO) + +(test-group "set->" + 'TODO) + +(test-group "and=>" + 'TODO) + +(test-group "downcase-symbol" + 'TODO) + + +(test-group "group" + ;; TODO test failure when grouping isn't possible? + (test-equal "Group" + '((0 1) (2 3) (4 5) (6 7) (8 9)) + (group (iota 10) 2))) + +(test-group "iterate" + (test-equal 0 (iterate 1- zero? 10))) + +(test-group "valued-map" + 'TODO) + +(test-group "assoc-ref-all" + (test-equal "assoc-ref-all" + '(1 3) (assoc-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) + (test-equal "assq-ref-all" + '(1 3) (assq-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) + (test-equal "assv-ref-all" + '(1 3) (assv-ref-all '((a . 1) (b . 2) (a . 3)) 'a))) + +(test-group "unique" + 'TODO) + +(test-group "vector-last" + (test-equal "vector-last" + 1 (vector-last #(0 2 3 1)))) + +(test-group "->string" + (test-equal "5" (->string 5)) + (test-equal "5" (->string "5"))) + +(test-group "catch*" + 'TODO) + diff --git a/tests/test/let-env.scm b/tests/test/let-env.scm deleted file mode 100644 index e3dc5927..00000000 --- a/tests/test/let-env.scm +++ /dev/null @@ -1,43 +0,0 @@ -(define-module (test let-env) - :use-module (srfi srfi-64) - :use-module (srfi srfi-64 test-error) - :use-module (srfi srfi-88) - :use-module ((guile) :select (setenv getenv)) - :use-module ((hnh util env) :select (let-env))) - -(setenv "CALP_TEST_ENV" "1") - -(test-equal - "Ensure we have set value beforehand" - "1" - (getenv "CALP_TEST_ENV")) - -(let-env - ((CALP_TEST_ENV "2")) - (test-equal - "Test our local override" - "2" - (getenv "CALP_TEST_ENV"))) - -(test-equal - "Test that we have returned" - "1" - (getenv "CALP_TEST_ENV")) - -(catch 'test-error - (lambda () - (let-env - ((CALP_TEST_ENV "2")) - (test-equal - "Test our local override again" - "2" - (getenv "CALP_TEST_ENV")) - (throw 'test-error))) - list) - -(test-equal - "Test restoration after non-local exit" - "1" - (getenv "CALP_TEST_ENV")) - - diff --git a/tests/test/util.scm b/tests/test/util.scm deleted file mode 100644 index 9a203f50..00000000 --- a/tests/test/util.scm +++ /dev/null @@ -1,375 +0,0 @@ -;;; Commentary: -;; Checks some prodecuders from (hnh util) -;;; Code: - -(define-module (test util) - :use-module (srfi srfi-64) - :use-module (srfi srfi-64 test-error) - :use-module (srfi srfi-88) - :use-module (srfi srfi-1) - :use-module (hnh util) - :use-module (hnh util env) - :use-module ((hnh util path) - :select (path-append - path-split - file-hidden? - realpath - relative-to - filename-extension))) - -(test-equal "when" - 1 (when #t 1)) - -(test-equal "'() when #f" - '() (when #f 1)) - -(test-equal "unless" - 1 (unless #f 1)) - -(test-equal "'() unless #t" - '() (unless #t 1)) - -(test-equal "awhen it" - '(3 4 5) - (awhen (memv 2 '(1 2 3 4 5)) - (cdr it))) - -(test-equal "awhen not" - '() - (awhen (memv 0 '(1 2 3 4 5)) - (cdr it))) - -(test-equal "for simple" - (iota 10) - (for x in (iota 10) - x)) - -(test-equal "for matching" - (iota 12) - (for (x c) in (zip (iota 12) (string->list "Hello, World")) - x)) - -(test-equal "for with improper list elements" - `(3 7) - (for (a . b) in '((1 . 2) (3 . 4)) - (+ a b))) - -(test-equal "for with longer improper list elements" - '(1 2 4) - (for (a b . c) in '((1 -1 . 1) (2 -2 . 2) (4 -4 . 4)) - (* c (+ 1 a b)))) - -(test-equal "procedure label" - 120 - ((label factorial (lambda (n) - (if (zero? n) - 1 (* n (factorial (1- n)))))) - 5)) - -;; we can't test if sort*! destroys the list, since its only /allowed/ to do it, -;; not required. -(test-equal "sort*!" - '("a" "Hello" "Assparagus") - (sort*! '("Hello" "a" "Assparagus") - < string-length)) - -(test-assert "not equal" - (!= 1 2)) - -(test-equal "Take to" - '() (take-to '() 5)) - -(test-equal "Enumerate" - '((0 #\H) (1 #\e) (2 #\l) (3 #\l) (4 #\o) (5 #\,) (6 #\space) (7 #\W) (8 #\o) (9 #\r) (10 #\l) (11 #\d) (12 #\!)) - (enumerate (string->list "Hello, World!"))) - -(test-equal "unval first" - 1 - ((unval (lambda () (values 1 2 3))))) - -(test-equal "unval other" - 2 - ((unval car+cdr 1) - (cons 1 2))) - -(test-equal "flatten already flat" - (iota 10) - (flatten (iota 10))) - -(test-equal "flatten really deep" - '(1) - (flatten '(((((((((((((((1))))))))))))))))) - -(test-equal "flatten mixed" - '(1 2 3 4 5) - (flatten '((((((1(((((2((((3))))))4))))))))5))) - -;; TODO test let-lazy - -(test-equal "map/dotted without dot" - '(1 2 3 4) - (map/dotted 1+ '(0 1 2 3))) - -(test-equal "map/dotted with dot" - '(1 2 3 . 4) - (map/dotted 1+ '(0 1 2 . 3))) - -(test-equal "map/dotted direct value" - 1 (map/dotted 1+ 0)) - -(test-equal "assq merge" - '((k 2 1) (v 2)) - (assq-merge '((k 1) (v 2)) '((k 2)))) - -(test-equal "kvlist->assq" - '((a . 1) (b . 2)) - (kvlist->assq '(a: 1 b: 2))) - - -(test-equal "kvlist->assq repeated key" - '((a . 1) (b . 2) (a . 3)) - (kvlist->assq '(a: 1 b: 2 a: 3))) - -;; TODO assq-limit ? - -(test-group "group by" - ;; Extra roundabout tests since groups-by doesn't guarantee order of the keys - (test-group "Two simple groups" - (let ((groups (group-by even? (iota 10)))) - (test-assert (lset= eq? '(#f #t) (map car groups))) - (test-assert (lset= = '(0 2 4 6 8) (assq-ref groups #t))) - (test-assert (lset= = '(1 3 5 7 9) (assq-ref groups #f))))) - - (test-group "Identity groups" - (let ((groups (group-by identity (iota 5)))) - (test-assert "Correct keys" - (lset= = (iota 5) (map car groups))) - (test-group "Correct amount in each group" - (for-each (lambda (g) (test-equal 1 (length (cdr g)))) groups)))) - - (test-equal "Null case" - '() - (group-by (lambda _ (/ 0)) '()))) - -(test-equal "->" 9 (-> 1 (+ 2) (* 3))) -(test-equal "-> order dependant" -1 (-> 1 (- 2))) -(test-equal "->> order dependant" 1 (->> 1 (- 2))) - -;; TODO set and set-> - -;; TODO and=>> - -(test-equal "Group" - '((0 1) (2 3) (4 5) (6 7) (8 9)) - (group (iota 10) 2)) - -;; TODO test failure when grouping isn't possible? - -(test-equal "assoc-ref-all" '(1 3) (assoc-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) -(test-equal "assq-ref-all" '(1 3) (assq-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) -(test-equal "assv-ref-all "'(1 3) (assv-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) - -(test-equal "vector-last" - 1 (vector-last #(0 2 3 1))) - -;; TODO test catch* - -(test-equal - "Filter sorted" - '(3 4 5) - (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10))) - -(test-equal - "set/r! = single" - #f - (let ((x #t)) (set/r! x = not))) - -(test-error - 'syntax-error - (test-read-eval-string "(set/r! x err not)")) - -(call-with-values - (lambda () (find-min (iota 10))) - (lambda (extreme rest) - (test-equal "Found correct minimum" 0 extreme) - (test-equal - "Removed \"something\" from the set" - 9 - (length rest)))) - -(call-with-values - (lambda () - (find-max - '("Hello" "Test" "Something long") - string-length)) - (lambda (extreme rest) - (test-equal - "Found the longest string" - "Something long" - extreme) - (test-equal "Removed the string" 2 (length rest)) - (test-assert - "Other members left 1" - (member "Hello" rest)) - (test-assert - "Other members left 2" - (member "Test" rest)))) - -(test-error 'wrong-type-arg (find-extreme '())) - -(call-with-values - (lambda () - (span-upto - 2 - char-numeric? - (string->list "123456"))) - (lambda (head tail) - (test-equal '(#\1 #\2) head) - (test-equal '(#\3 #\4 #\5 #\6) tail))) - -(call-with-values - (lambda () - (span-upto - 2 - char-numeric? - (string->list "H123456"))) - (lambda (head tail) - (test-equal '() head) - (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))) - -(let ((value #f)) - (test-equal - "begin1 return value" - "Hello" - (begin1 "Hello" (set! value "World"))) - (test-equal "begin1 side effects" "World" value)) - -(let ((x 1)) - (test-eqv "begin1 set! after return" - 1 (begin1 x (set! x 10))) - (test-eqv "Updates value" - 10 x)) - -(test-equal 0 (iterate 1- zero? 10)) - -(test-equal "5" (->string 5)) - -(test-equal "5" (->string "5")) - -(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")) |