From bda166e6050f799b4d99574632474f2760b75a21 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 13 Sep 2023 12:57:03 +0200
Subject: Remove accidentially duplicated tests from merge.

---
 tests/test/hnh-util-env.scm |  54 +++----
 tests/test/hnh-util.scm     | 372 ++++++++++++++++++++-----------------------
 tests/test/let-env.scm      |  48 ------
 tests/test/state-monad.scm  | 121 --------------
 tests/test/util.scm         | 379 --------------------------------------------
 5 files changed, 202 insertions(+), 772 deletions(-)
 delete mode 100644 tests/test/let-env.scm
 delete mode 100644 tests/test/state-monad.scm
 delete mode 100644 tests/test/util.scm

diff --git a/tests/test/hnh-util-env.scm b/tests/test/hnh-util-env.scm
index f38a3a3b..c1e0161f 100644
--- a/tests/test/hnh-util-env.scm
+++ b/tests/test/hnh-util-env.scm
@@ -5,14 +5,11 @@
   :use-module ((guile) :select (setenv getenv))
   :use-module ((hnh util env) :select (let-env)))
 
+(setenv "CALP_TEST_ENV" "1")
 
-(test-group "let-env"
-  (setenv "CALP_TEST_ENV" "1")
-
-  (test-equal
-      "Ensure we have set value beforehand"
-    "1"
-    (getenv "CALP_TEST_ENV"))
+(test-equal "Ensure we have set value beforehand"
+  "1"
+  (getenv "CALP_TEST_ENV"))
 
   (let-env
    ((CALP_TEST_ENV "2"))
@@ -26,24 +23,25 @@
     "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)
-
-(test-group "with-locale"
-  'TODO)
+(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 "Unsetting environment"
+  (setenv "TEST" "A")
+  (let-env ((TEST #f))
+           (test-assert (not (getenv "TEST"))))
+  (test-equal "A" (getenv "TEST")))
diff --git a/tests/test/hnh-util.scm b/tests/test/hnh-util.scm
index 4e50ac1b..c4a20443 100644
--- a/tests/test/hnh-util.scm
+++ b/tests/test/hnh-util.scm
@@ -45,19 +45,18 @@
 ;; (test-group "define-syntax"
 ;;   )
 
-(test-group "when"
+(test-group "Conditionals"
  (test-equal "when"
    1 (when #t 1))
 
  (test-equal "'() when #f"
-   '() (when #f 1)))
+   '() (when #f 1))
 
-(test-group "unless"
  (test-equal "unless"
    1 (unless #f 1))
 
  (test-equal "'() unless #t"
-   '() (unless #t 1)))
+   '() (unless #t 1))
 
 
 
@@ -72,7 +71,6 @@
        (unreachable)
        (test-assert #t)))
 
-(test-group "awhen"
  (test-equal "awhen it"
    '(3 4 5)
    (awhen (memv 2 '(1 2 3 4 5))
@@ -102,21 +100,26 @@
  (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)))
+        (* c (+ 1 a b))))
+
+ (test-equal "for break"
+   'x
+   (for x in (iota 10)
+        (break 'x)
+        (test-assert "This should never happen" #f)))
+
+ (test-equal "for continue"
+   '(x #f 2)
+   (for x in (iota 3)
+        (case x
+          ((0)
+           (continue 'x)
+           (test-assert "Continue with value failed" #f))
+          ((1)
+           (continue)
+           (test-assert "Continue without value failed" #f))
+          (else x)))))
+
 
 (test-group "print-and-return"
   (let ((p (open-output-string)))
@@ -132,82 +135,31 @@
       '(3 2 1)
     ((swap list) 1 2 3)))
 
-(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-equal "procedure label"
+  120
+  ((label factorial (lambda (n)
+                      (if (zero? n)
+                          1 (* n (factorial (1- n))))))
+   5))
 
-  (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))))))
+;; 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 "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 "init+last"
-  'TODO)
 
-(test-group "take-to"
- (test-equal "Take to"
-   '() (take-to '() 5)))
+
+(test-assert "not equal"
+  (!= 1 2))
+
+(test-equal "Take to"
+  '() (take-to '() 5))
 
 (test-group "string-take-to"
   (test-equal "Hello"
@@ -226,24 +178,20 @@
     '() (as-symb '())))
 
 
-(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 "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 other"
-   2
-   ((unval car+cdr 1)
-    (cons 1 2))))
+(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-group "Flatten"
  (test-equal "flatten already flat"
    (iota 10)
    (flatten (iota 10)))
@@ -256,38 +204,20 @@
    '(1 2 3 4 5)
    (flatten '((((((1(((((2((((3))))))4))))))))5))))
 
-(test-group "let-lazy"
-  'TODO)
+;; TODO test let-lazy
 
 (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-equal "map/dotted without dot"
+    '(1 2 3 4)
+    (map/dotted 1+ '(0 1 2 3)))
 
-(test-group "assq-merge"
-  (test-equal "assq merge"
-    '((k 2 1) (v 2))
-    (assq-merge '((k 1) (v 2)) '((k 2)))))
+  (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 "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"
@@ -313,28 +243,6 @@
   '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"
   (test-equal "Basic case"
@@ -365,64 +273,136 @@
      '(3 4)
      '(5 6))))
 
-(test-group "string-flatten"
-  'TODO)
-
-(test-group "intersperse"
-  'TODO)
-
-(test-group "insert-ordered"
-  'TODO)
-
-(test-group "-> (arrows)"
+(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)
+;; TODO set and set->
 
-(test-group "set->"
-  'TODO)
+;; TODO and=>>
 
-(test-group "and=>"
-  'TODO)
+;; downcase-symbol
 
-(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)))
+;; 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)))
+;; TODO test failure when grouping isn't possible?
 
-(test-group "valued-map"
-  'TODO)
+(test-group "Associations"
+  (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 "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)))
+  ;; TODO assq-limit ?
 
-(test-group "unique"
-  'TODO)
+  (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))))
 
-(test-group "vector-last"
-  (test-equal "vector-last"
-    1 (vector-last #(0 2 3 1))))
+(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)"))
+
+(test-group "Find extremes"
+  (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 "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 "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-equal 0 (iterate 1- zero? 10))
 
 (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 a989776a..00000000
--- a/tests/test/let-env.scm
+++ /dev/null
@@ -1,48 +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"))
-
-
-(test-group "Unsetting environment"
-  (setenv "TEST" "A")
-  (let-env ((TEST #f))
-           (test-assert (not (getenv "TEST"))))
-  (test-equal "A" (getenv "TEST")))
diff --git a/tests/test/state-monad.scm b/tests/test/state-monad.scm
deleted file mode 100644
index a4e28b78..00000000
--- a/tests/test/state-monad.scm
+++ /dev/null
@@ -1,121 +0,0 @@
-;;; Borrowed from guile-dns
-
-(define-module (test state-monad)
-  :use-module (srfi srfi-64)
-  :use-module (srfi srfi-88)
-  :use-module (hnh util state-monad)
-  )
-
-(call-with-values (lambda () ((return 1) 2))
-  (lambda (value state)
-    (test-equal "Return returns the value unmodified" 1 value)
-    (test-equal "Return also returns the state as a second value" 2 state)))
-
-(test-equal "Get returns the current state as primary value, while kepping the state"
-  '(state state)
-  (call-with-values (lambda () ((get) 'state)) list))
-
-;; Return value of put untested, since it's undefined
-(test-equal "Put replaces the old state with a new one, and return old one"
-  '(old-state new-state)
-  (call-with-values (lambda () ((put 'new-state) 'old-state))
-    list))
-
-(test-equal "A simple do is effectively a `values' call"
-  '(value initial-state)
-  (call-with-values (lambda () ((do (return 'value)) 'initial-state))
-    list))
-
-(test-equal "Let statement in do"
-  '(10 state)
-  (call-with-values (lambda () ((do x = 10
-                                  (return x))
-                                'state))
-                    list))
-
-;; TODO let statement with multiple binds
-;; (do let (a b) = (values 10 20) ...)
-
-(test-equal "Set and get through do, along with <- in do."
-  '(5 1)
-  (call-with-values (lambda () ((do old <- (get)
-                               (put (1+ old))
-                               (return 5))
-                           0))
-    list))
-
-
-
-(test-equal "<$> Updates stuff before being removed from the monad context"
-    '(11 10)
- (call-with-values (lambda ()
-                     ((do x <- (<$> 1+ (get))
-                          (return x))
-                      10))
-   list))
-
-(test-equal "Sequence should update the state accordingly"
-  3
-  (call-with-values
-      (lambda ()
-        ((sequence
-           (list (mod 1+)
-                 (mod 1+)
-                 (mod 1+)))
-         0))
-    (lambda (_ st) st)))
-
-(test-equal "Sequence should also act as map on the primary value"
-  '((0 1 2) 3)
-  (call-with-values
-      (lambda ()
-        ((sequence
-           (list (mod 1+)
-                 (mod 1+)
-                 (mod 1+)))
-         0))
-    list))
-
-(test-equal "Get returns a single value when only a single value is in the state"
-  '(1 1) (call-with-values (lambda () ((get) 1))
-           list))
-
-(test-equal "Get returns a list of values when multiple items are in the state"
-  '((1 2 3) 1 2 3)
-  (call-with-values (lambda ()  ((get) 1 2 3))
-    list))
-
-(test-equal "Get with multiple values"
-  '((1 2) 1 2)
-  (call-with-values (lambda () ((get) 1 2))
-    list))
-
-(test-equal "Get with multiple values in do"
-  '((1 2) 1 2)
-  (call-with-values (lambda ()
-                     ((do (a b) <- (get)
-                          (return (list a b)))
-                      1 2))
-    list))
-
-((do (put 0)
-     (with-temp-state
-      (list 10)
-      (do a <- (get)
-          (return (test-equal "Temporary state is set"
-                    10 a))
-          (put 20)))
-   a <- (get)
-   (return (test-equal "Pre-temp state is restored" 0 a)))
- 'init)
-
-
-;; TODO test for do where the number of implicit arguments changes
-
-(test-equal "Something" 30
-            ((do (with-temp-state
-                  '(10 20)
-                  ;; todo (lift +)
-                  (do (a b) <- (get)
-                      (return (+ a b)))))
-             0 1))
diff --git a/tests/test/util.scm b/tests/test/util.scm
deleted file mode 100644
index bdd6e98e..00000000
--- a/tests/test/util.scm
+++ /dev/null
@@ -1,379 +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-group "Conditionals"
- (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-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-equal "for break"
-   'x
-   (for x in (iota 10)
-        (break 'x)
-        (test-assert "This should never happen" #f)))
-
- (test-equal "for continue"
-   '(x #f 2)
-   (for x in (iota 3)
-        (case x
-          ((0)
-           (continue 'x)
-           (test-assert "Continue with value failed" #f))
-          ((1)
-           (continue)
-           (test-assert "Continue without value failed" #f))
-          (else x)))))
-
-(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-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))))
-
-;; TODO test let-lazy
-
-(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 "Arrows"
-  (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-group "Associations"
-  (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))
-
-  ;; TODO assq-limit ?
-
-  (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))))
-
-(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)"))
-
-(test-group "Find extremes"
-  (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 '())))
-
-(test-group "Span upto"
-  (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))))
-
-(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-equal 0 (iterate 1- zero? 10))
-
-(test-equal "5" (->string 5))
-
-(test-equal "5" (->string "5"))
-
-(test-group "Path operations"
-  (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-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")))
-- 
cgit v1.2.3