From a3b3249bb5162d9b7a040cc05d968c1be9260f2c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 10 Sep 2023 17:14:09 +0200
Subject: Split test/util.scm into groups.

---
 tests/test/util.scm | 401 ++++++++++++++++++++++++++--------------------------
 1 file changed, 203 insertions(+), 198 deletions(-)

diff --git a/tests/test/util.scm b/tests/test/util.scm
index b25c9add..81bebdb5 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -17,27 +17,28 @@
                         relative-to
                         filename-extension)))
 
-(test-equal "when"
-  1 (when #t 1))
+(test-group "Conditionals"
+ (test-equal "when"
+   1 (when #t 1))
 
-(test-equal "'() when #f"
-  '() (when #f 1))
+ (test-equal "'() when #f"
+   '() (when #f 1))
 
-(test-equal "unless"
-  1 (unless #f 1))
+ (test-equal "unless"
+   1 (unless #f 1))
 
-(test-equal "'() unless #t"
-  '() (unless #t 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 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 "awhen not"
+   '()
+   (awhen (memv 0 '(1 2 3 4 5))
+          (cdr it))))
 
 (test-group "for"
  (test-equal "for simple"
@@ -97,49 +98,39 @@
   ((unval car+cdr 1)
    (cons 1 2)))
 
-(test-equal "flatten already flat"
-  (iota 10)
-  (flatten (iota 10)))
+(test-group "Flatten"
+ (test-equal "flatten already flat"
+   (iota 10)
+   (flatten (iota 10)))
 
-(test-equal "flatten really deep"
-  '(1)
-  (flatten '(((((((((((((((1)))))))))))))))))
+ (test-equal "flatten really deep"
+   '(1)
+   (flatten '(((((((((((((((1)))))))))))))))))
 
-(test-equal "flatten mixed"
-  '(1 2 3 4 5)
-  (flatten '((((((1(((((2((((3))))))4))))))))5)))
+ (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-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"
+  (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))))
+    (map/dotted 1+ '(0 1 2 . 3)))
 
-(test-equal "kvlist->assq"
-  '((a 1) (b 2))
-  (kvlist->assq '(a: 1 b: 2)))
+  (test-equal "map/dotted direct value"
+    1 (map/dotted 1+ 0)))
 
 
-(test-equal "kvlist->assq repeated key"
-  '((a 1) (b 2) (a 3))
-  (kvlist->assq '(a: 1 b: 2 a: 3)))
+(test-group "Arrows"
 
-;; TODO assq-limit ?
-
-(test-equal "->" 9 (-> 1 (+ 2) (* 3)))
-(test-equal "-> order dependant" -1 (-> 1 (- 2)))
-(test-equal "->> order dependant" 1 (->> 1 (- 2)))
+  (test-equal "->" 9 (-> 1 (+ 2) (* 3)))
+  (test-equal "-> order dependant" -1 (-> 1 (- 2)))
+  (test-equal "->> order dependant" 1 (->> 1 (- 2))))
 
 ;; TODO set and set->
 
@@ -151,9 +142,25 @@
 
 ;; 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-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)))
@@ -174,67 +181,70 @@
   '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-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
-      "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))
+        "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))
+  (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))
 
@@ -242,122 +252,117 @@
 
 (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-group "Path operations"
+  (test-equal
+      "no slashes"
+    "home/user"
+    (path-append "home" "user"))
 
-(test-equal
-  "slashes in one component, absolute"
-  "/home/user"
-  (path-append "" "/home/" "user"))
+  (test-equal
+      "no slashes, 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 one component, absolute"
+    "/home/user"
+    (path-append "" "/home/" "user"))
 
-(test-equal
-  "Slashes in both"
-  "home/user"
-  (path-append "home/" "/user"))
+  (test-equal
+      "slashes in one component, absolute due to first"
+    "/home/user"
+    (path-append "/home/" "user"))
 
-(test-equal "root" "/" (path-append ""))
+  (test-equal
+      "Slashes in both"
+    "home/user"
+    (path-append "home/" "/user"))
 
-(test-equal "No components" "" (path-append))
+  (test-equal "root" "/" (path-append ""))
 
-(test-equal
-  '("usr" "lib" "test")
-  (path-split "usr/lib/test"))
+  (test-equal "No components" "" (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-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? "")))
+  (test-equal
+      '("" "usr" "lib" "test")
+    (path-split "//usr////lib/test"))
 
-;; TODO test realpath with .. and similar
+  (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? "")))
 
-(test-equal "Realpath for path fragment"
-  "/home/hugo"
-  (with-working-directory
-   "/home"
-   (lambda () (realpath "hugo"))))
+  ;; TODO test realpath with .. and similar
 
-(test-equal "Realpath for already absolute path"
-  "/home/hugo"
-  (with-working-directory
-   "/tmp"
-   (lambda () (realpath "/home/hugo"))))
+  (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 "Relative to"
 
-  (test-group "With relative child"
-    (test-equal "/some/path" (relative-to "/some" "path")))
+    (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")
+    ;; 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-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 "/a/b" (relative-to "/a/b/c" "/a/b"))
 
-  )
+    )
 
 
-(test-equal "Extension of simple file"
-  "txt" (filename-extension "file.txt"))
+  (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 directory"
+    "txt" (filename-extension "/direcotry/file.txt"))
 
-(test-equal "Extension of file with multiple"
-  "gz" (filename-extension "filename.tar.gz"))
+  (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"
+    "" (filename-extension "filename"))
 
-(test-equal "Filename extension when none is present, but directory has"
-  "" (filename-extension "config.d/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 "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"
+    "sh" (filename-extension ".bashrc.sh"))
 
-(test-equal "Extension of hidden file without extension"
-  "bashrc" (filename-extension ".bashrc"))
+  (test-equal "Extension of hidden file without extension"
+    "bashrc" (filename-extension ".bashrc")))
-- 
cgit v1.2.3