From ed4281ff072443167c43207c039570126061d23b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 12 Apr 2022 13:30:32 +0200
Subject: Add a lot of new unit tests.

---
 tests/convert.scm                  |  69 ++++++++++++
 tests/test/crypto.scm              |   3 +
 tests/test/datetime.scm            | 214 +++++++++++++++++++++++++++++++++++--
 tests/test/html/caltable.scm       | 105 ++++++++++++++++++
 tests/test/html/component.scm      |  59 ++++++++++
 tests/test/recurrence-advanced.scm |  34 +++++-
 tests/test/srfi-41-util.scm        |  58 ++++++++--
 tests/test/translation.scm         |  15 +++
 tests/test/util.scm                | 148 ++++++++++++++++++++++---
 tests/test/uuid.scm                |  12 +++
 10 files changed, 683 insertions(+), 34 deletions(-)
 create mode 100644 tests/convert.scm
 create mode 100644 tests/test/html/caltable.scm
 create mode 100644 tests/test/html/component.scm
 create mode 100644 tests/test/translation.scm
 create mode 100644 tests/test/uuid.scm

(limited to 'tests')

diff --git a/tests/convert.scm b/tests/convert.scm
new file mode 100644
index 00000000..534c5b70
--- /dev/null
+++ b/tests/convert.scm
@@ -0,0 +1,69 @@
+(add-to-load-path "../module")
+
+(use-modules (ice-9 documentation)
+             (ice-9 format)
+             (srfi srfi-1)
+             (hnh util path)
+             (datetime)
+             )
+
+(print-set! quote-keywordish-symbols #f)
+
+(define (module-definition name old-sandbox-definition)
+ `(define-module (test ,name)
+    :use-module (srfi srfi-64)
+    :use-module (srfi srfi-88)
+    ,@(concatenate
+       (map (lambda (def) `(:use-module (,(car def) :select ,(cdr def))))
+            old-sandbox-definition))))
+
+(define (read-multiple port)
+  (let loop ((done '()))
+    (let ((sexp (read port)))
+      (if (eof-object? sexp)
+          (reverse done)
+          (loop (cons sexp done))))))
+
+(define files
+ '("annoying-events.scm"
+   "base64.scm"
+   "cpp.scm"
+   "datetime-compare.scm"
+   "datetime.scm"
+   "datetime-util.scm"
+   "let-env.scm"
+   "let.scm"
+   "param.scm"
+   "recurrence-advanced.scm"
+   "recurrence-simple.scm"
+   "rrule-serialization.scm"
+   "server.scm"
+   "srfi-41-util.scm"
+   "termios.scm"
+   "tz.scm"
+   "util.scm"
+   "vcomponent-control.scm"
+   "vcomponent-datetime.scm"
+   "vcomponent-formats-common-types.scm"
+   "vcomponent.scm"
+   "web-server.scm"
+   "xcal.scm"
+   "xml-namespace.scm"
+   ))
+
+(for-each (lambda (file)
+            (format #t "~a~%" file)
+            (call-with-output-file (path-append "test" (basename file))
+              (lambda (p)
+                (define commentary (file-commentary file))
+                (unless (string-null? commentary)
+                  (format p ";;; Commentary:~%")
+                  (for-each (lambda (line) (format p ";; ~a~%" line))
+                            (string-split commentary #\newline))
+                  (format p ";;; Code:~%~%"))
+                (let ((forms (call-with-input-file file read-multiple)))
+                  (format p "~y~%" (module-definition (string->symbol (string-drop-right file 4))
+                                                      (car forms)))
+                  (format p "~{~y~%~}~%" (cdr forms))))))
+          files)
+
diff --git a/tests/test/crypto.scm b/tests/test/crypto.scm
index 71ecfc99..8d195fa8 100644
--- a/tests/test/crypto.scm
+++ b/tests/test/crypto.scm
@@ -13,3 +13,6 @@
   (test-equal "sha256 string digest to port"
     "185f8db32271fe25f561a6fc938b2e264306ec304eda518007d1764826381969"
     (get-output-string port)))
+
+(test-error 'wrong-type-arg
+  (sha256 'something-which-is-not-a-string-or-bytevector))
diff --git a/tests/test/datetime.scm b/tests/test/datetime.scm
index d9c08ec2..8648006b 100644
--- a/tests/test/datetime.scm
+++ b/tests/test/datetime.scm
@@ -12,7 +12,7 @@
   :use-module ((ice-9 format) :select (format))
   :use-module ((hnh util) :select (let*))
   :use-module ((ice-9 i18n) :select (make-locale))
-  :use-module ((guile) :select (LC_TIME)))
+  :use-module ((guile) :select (LC_CTYPE LC_TIME)))
 
 (test-equal
   "empty time"
@@ -55,6 +55,17 @@
     "~a"
     #2020-01-01))
 
+(test-equal "time print"
+  "#20:30:40"
+  (format #f "~a" #20:30:40))
+
+(test-equal "time print bad"
+  "#<<time> hour=#f minute=1 second=2>"
+  (format #f "~a" (time hour: #f
+                        minute: 1
+                        second: 2)))
+
+
 (test-equal
   "Syntax date="
   (date year: 2020 month: 1 day: 1)
@@ -72,16 +83,19 @@
   #2020-01-01T13:37:00)
 
 (test-equal
+    "Date- over leap year month shift"
   #2020-02-28
   (date- #2020-03-05
          (date day: 6)))
 
 (test-equal
+    "Date- land on leap day"
   #2020-02-29
   (date- #2020-03-05
          (date day: 5)))
 
 (test-equal
+    "Date- within month"
   #2020-03-01
   (date- #2020-03-05
          (date day: 4)))
@@ -144,6 +158,7 @@
          #2020-01-01))
 
 (test-equal
+    "Simple datetime construction"
   #2020-01-01T10:00:00
   (datetime
     date:
@@ -152,6 +167,7 @@
     #10:00:00))
 
 (test-equal
+    "Datetime add date-only and time-only."
   #2020-01-01T10:00:00
   (datetime+
     (datetime
@@ -162,6 +178,7 @@
       #10:00:00)))
 
 (test-equal
+    "Datetime subtract time"
   #2020-10-09T14:00:00
   (datetime-
     #2020-10-10T00:00:00
@@ -170,12 +187,14 @@
       #10:00:00)))
 
 (test-equal
+    "Datetime subtract datetime"
   #2020-09-24T14:00:00
   (datetime-
     #2020-10-10T00:00:00
     #0000-00-15T10:00:00))
 
 (test-equal
+    "Date+ multiple"
   #2020-03-10
   (date+ #2020-03-01
          (date day: 4)
@@ -228,12 +247,15 @@
 ;; NOTE
 ;; at the time of writing this returns #2020-02-00
 ;; The general question is, how is the last in a month handled?
+;; TODO
 (test-equal
+    "Date+ over year end"
   #2020-01-31
   (date+ #2019-12-31
          (date month: 1)))
 
-(test-assert (leap-year? 2020))
+
+(test-assert "leap-year?" (leap-year? 2020))
 
 (test-equal
   "Add to Leap day"
@@ -271,7 +293,7 @@
   (string->date
     "Maj"
     "~b"
-    (make-locale LC_TIME "sv_SE.UTF-8")))
+    (make-locale (list LC_CTYPE LC_TIME) "sv_SE.UTF-8")))
 
 (test-equal
   "Parse month (english)"
@@ -279,7 +301,7 @@
   (string->date
     "May"
     "~b"
-    (make-locale LC_TIME "en_US.UTF-8")))
+    (make-locale (list LC_CTYPE LC_TIME) "en_US.UTF-8")))
 
 (test-equal
   "AM/PM AM"
@@ -346,20 +368,30 @@
   (string->date "6, " "~d, "))
 
 (define en_US
-  (make-locale LC_TIME "en_US.UTF-8"))
+  (make-locale (list LC_CTYPE LC_TIME) "en_US.UTF-8"))
 
 (define sv_SE
-  (make-locale LC_TIME "sv_SE.UTF-8"))
+  (make-locale (list LC_CTYPE LC_TIME) "sv_SE.UTF-8"))
+
+(test-equal "Week day name"
+  "söndag" (week-day-name sun locale: sv_SE))
+(test-equal "Week day name (modulo)"
+  "söndag" (week-day-name (+ 7 sun) locale: sv_SE))
 
-(test-equal 1 (parse-month "jan" en_US))
+(test-equal "en month name - january"
+  1 (parse-month "jan" en_US))
 
-(test-equal 1 (parse-month "jan" sv_SE))
+(test-equal "sv month name - januari"
+  1 (parse-month "jan" sv_SE))
 
-(test-equal 12 (parse-month "dec" en_US))
+(test-equal "en month name - december"
+  12 (parse-month "dec" en_US))
 
-(test-equal -1 (parse-month "inv" en_US))
+(test-equal "en month name - invalid"
+  -1 (parse-month "inv" en_US))
 
-(test-equal 5 (parse-month "mAJ" sv_SE))
+(test-equal "sv month name - mAJ"
+  5 (parse-month "mAJ" sv_SE))
 
 (test-equal
   "Days in regular year"
@@ -374,6 +406,166 @@
   (days-in-interval
     #2020-01-01
     #2020-12-31))
+
+
+
+(test-error "Construct invalid date (year)"
+  'wrong-type-arg
+  (date year: #f))
+
+(test-error "Construct invalid date (month)"
+  'wrong-type-arg
+  (date month: #f))
+
+(test-error "Construct invalid date (day)"
+  'wrong-type-arg
+  (date day: #f))
+
+
+(test-assert "Current date is a date"
+  (date? (current-date)))
+
+(let ((t #20:30:40))
+  (test-equal "As-time identity" t (as-time t)))
+
+(let ((d #2020-10-05))
+  (test-equal "As-date identity" d (as-date d)))
+
+(test-equal "As-time date == 0"
+  (time) (as-time (date)))
+(test-equal "As-date time == 0"
+  (date) (as-date (time)))
+
+(test-error "As-time invalid argument"
+  'wrong-type-arg
+  (as-time #f))
+
+(test-error "As-date invalid argument"
+   'wrong-type-arg
+  (as-date #f))
+
+(test-error "As-datetime invalid argument"
+  'wrong-type-arg
+  (as-datetime #f))
+
+(test-assert "Time-zero on empty time"
+  (time-zero? (time)))
+
+(test-error "Invalid month (below)"
+  'out-of-range
+  (days-in-month (date year: 2020 month: 0)))
+
+(test-error "Invalid month (above)"
+  'out-of-range
+  (days-in-month (date year: 2020 month: 13)))
+
+;; This both tests days-in-year for both cases, and leap year code for the weird years.
+(test-equal "Leap year exception exception"
+  366 (days-in-year (date year: 2000)))
+(test-equal "Leap year exception"
+  365 (days-in-year (date year: 1800)))
+
+(test-equal "End of month leap year"
+  #2020-02-29
+  (end-of-month #2020-02-05))
+
+(test-equal "Time-min"
+  (time)
+  (time-min (time) (time hour: 1)))
+
+(test-equal "Time-max"
+  (time hour: 1)
+  (time-max (time) (time hour: 1)))
+
+(test-equal "Date-min"
+  (date)
+  (date-min (date) (date year: 1)))
+
+(test-equal "Date-max"
+  (date year: 1)
+  (date-max (date) (date year: 1)))
+
+(test-equal "Datetime-min"
+  (datetime)
+  (datetime-min (datetime)
+                (datetime hour: 1)))
+
+(test-equal "Datetime-max"
+  (datetime hour: 1)
+  (datetime-max (datetime)
+                (datetime hour: 1)))
+
+;; month± mostly here for coverage,
+;; actual tests are for date±
+(test-equal "month+ dflt"
+  (date month: 3 day: 1)
+  (month+ (date month: 2 day: 1)))
+
+(test-equal "month+ given change"
+  (date month: 4 day: 1)
+  (month+ (date month: 2 day: 1) 2))
+
+(test-equal "month- dflt"
+  (date month: 1 day: 1)
+  (month- (date month: 2 day: 1)))
+
+(test-equal "month- given change"
+  (date month: 2 day: 1)
+  (month- (date month: 4 day: 1) 2))
+
+;; same for {add,remove}-day; mostly here for coverage.
+
+(test-equal "add-day"
+  (date month: 1 day: 2)
+  (add-day (date month: 1 day: 1)))
+
+(test-equal "remove-day"
+  (date month: 1 day: 1)
+  (remove-day (date month: 1 day: 2)))
+
+;; TODO more week-number tests
+(test-equal "Week 53"
+  53 (week-number #2020-12-28 mon))
+
+(test-equal "End of week"
+  #2022-04-17 (end-of-week #2022-04-11 mon))
+(test-equal "End of week (wednesday)"
+  #2022-04-12 (end-of-week #2022-04-11 wed))
+
+(define-values (pre mid post)
+  (month-days #2020-03-01 mon))
+(test-equal "month-days pre"
+  (list #2020-02-24 #2020-02-25 #2020-02-26 #2020-02-27 #2020-02-28 #2020-02-29)
+  pre)
+(test-equal "month-days mid"
+  (list #2020-03-01 #2020-03-02 #2020-03-03 #2020-03-04 #2020-03-05 #2020-03-06 #2020-03-07 #2020-03-08 #2020-03-09 #2020-03-10 #2020-03-11 #2020-03-12 #2020-03-13 #2020-03-14 #2020-03-15 #2020-03-16 #2020-03-17 #2020-03-18 #2020-03-19 #2020-03-20 #2020-03-21 #2020-03-22 #2020-03-23 #2020-03-24 #2020-03-25 #2020-03-26 #2020-03-27 #2020-03-28 #2020-03-29 #2020-03-30 #2020-03-31)
+  mid)
+(test-equal "month-days post"
+  (list #2020-04-01 #2020-04-02 #2020-04-03 #2020-04-04 #2020-04-05)
+  post)
+
+(test-equal "Year day"
+  32 (year-day #2020-02-01))
+
+(test-equal "time->decimal-hour"
+  10.5 (time->decimal-hour #10:30:00))
+
+(test-equal "datetime->decimal-hour"
+  34.5
+  (datetime->decimal-hour
+   (datetime day: 1 time: #10:30:00)))
+
+(test-error "Datetime->decimal-hour fail on multi month"
+  'misc-error
+  (datetime->decimal-hour (datetime month: 1)))
+
+(test-equal
+    "Datetime->decimal hour suceed on multi month"
+    (exact->inexact (* 24 28))
+  (datetime->decimal-hour (datetime month: 1)
+                          #2022-02-01))
+
+
 
 
 ;;; Commentary:
diff --git a/tests/test/html/caltable.scm b/tests/test/html/caltable.scm
new file mode 100644
index 00000000..d9eeca3e
--- /dev/null
+++ b/tests/test/html/caltable.scm
@@ -0,0 +1,105 @@
+(define-module (test html caltable)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-64 test-error)
+  :use-module (srfi srfi-88)
+  :use-module (calp html caltable)
+  :use-module (datetime)
+  ;; causes translated parts of the generated document to work
+  :use-module (calp translation)
+  )
+
+;; Not the most robust test, but at least it shows us when we break something
+(test-equal "Whole fucking caltable"
+  `(div (@ (class "small-calendar"))
+        (div (@ (class "column-head row-head")) ,(_ "v."))
+        (div (@ (class "column-head")) "Må")
+        (div (@ (class "column-head")) "Ti")
+        (div (@ (class "column-head")) "On")
+        (div (@ (class "column-head")) "To")
+        (div (@ (class "column-head")) "Fr")
+        (div (@ (class "column-head")) "Lö")
+        (div (@ (class "column-head")) "Sö")
+        (div (@ (class "row-head")) 13)
+        (div (@ (class "row-head")) 14)
+        (div (@ (class "row-head")) 15)
+        (div (@ (class "row-head")) 16)
+        (div (@ (class "row-head")) 17)
+        (a (@ (class "prev")
+              (href "2022-03-01.html" "#" "2022-03-28"))
+           (time (@ (datetime "2022-03-28")) 28))
+        (a (@ (class "prev")
+              (href "2022-03-01.html" "#" "2022-03-29"))
+           (time (@ (datetime "2022-03-29")) 29))
+        (a (@ (class "prev")
+              (href "2022-03-01.html" "#" "2022-03-30"))
+           (time (@ (datetime "2022-03-30")) 30))
+        (a (@ (class "prev")
+              (href "2022-03-01.html" "#" "2022-03-31"))
+           (time (@ (datetime "2022-03-31")) 31))
+        (a (@ (href "#" "2022-04-01"))
+           (time (@ (datetime "2022-04-01")) 1))
+        (a (@ (href "#" "2022-04-02"))
+           (time (@ (datetime "2022-04-02")) 2))
+        (a (@ (href "#" "2022-04-03"))
+           (time (@ (datetime "2022-04-03")) 3))
+        (a (@ (href "#" "2022-04-04"))
+           (time (@ (datetime "2022-04-04")) 4))
+        (a (@ (href "#" "2022-04-05"))
+           (time (@ (datetime "2022-04-05")) 5))
+        (a (@ (href "#" "2022-04-06"))
+           (time (@ (datetime "2022-04-06")) 6))
+        (a (@ (href "#" "2022-04-07"))
+           (time (@ (datetime "2022-04-07")) 7))
+        (a (@ (href "#" "2022-04-08"))
+           (time (@ (datetime "2022-04-08")) 8))
+        (a (@ (href "#" "2022-04-09"))
+           (time (@ (datetime "2022-04-09")) 9))
+        (a (@ (href "#" "2022-04-10"))
+           (time (@ (datetime "2022-04-10")) 10))
+        (a (@ (href "#" "2022-04-11"))
+           (time (@ (datetime "2022-04-11")) 11))
+        (a (@ (href "#" "2022-04-12"))
+           (time (@ (datetime "2022-04-12")) 12))
+        (a (@ (href "#" "2022-04-13"))
+           (time (@ (datetime "2022-04-13")) 13))
+        (a (@ (href "#" "2022-04-14"))
+           (time (@ (datetime "2022-04-14")) 14))
+        (a (@ (href "#" "2022-04-15"))
+           (time (@ (datetime "2022-04-15")) 15))
+        (a (@ (href "#" "2022-04-16"))
+           (time (@ (datetime "2022-04-16")) 16))
+        (a (@ (href "#" "2022-04-17"))
+           (time (@ (datetime "2022-04-17")) 17))
+        (a (@ (href "#" "2022-04-18"))
+           (time (@ (datetime "2022-04-18")) 18))
+        (a (@ (href "#" "2022-04-19"))
+           (time (@ (datetime "2022-04-19")) 19))
+        (a (@ (href "#" "2022-04-20"))
+           (time (@ (datetime "2022-04-20")) 20))
+        (a (@ (href "#" "2022-04-21"))
+           (time (@ (datetime "2022-04-21")) 21))
+        (a (@ (href "#" "2022-04-22"))
+           (time (@ (datetime "2022-04-22")) 22))
+        (a (@ (href "#" "2022-04-23"))
+           (time (@ (datetime "2022-04-23")) 23))
+        (a (@ (href "#" "2022-04-24"))
+           (time (@ (datetime "2022-04-24")) 24))
+        (a (@ (href "#" "2022-04-25"))
+           (time (@ (datetime "2022-04-25")) 25))
+        (a (@ (href "#" "2022-04-26"))
+           (time (@ (datetime "2022-04-26")) 26))
+        (a (@ (href "#" "2022-04-27"))
+           (time (@ (datetime "2022-04-27")) 27))
+        (a (@ (href "#" "2022-04-28"))
+           (time (@ (datetime "2022-04-28")) 28))
+        (a (@ (href "#" "2022-04-29"))
+           (time (@ (datetime "2022-04-29")) 29))
+        (a (@ (href "#" "2022-04-30"))
+           (time (@ (datetime "2022-04-30")) 30))
+        (a (@ (class "next")
+              (href "2022-05-01.html" "#" "2022-05-01"))
+           (time (@ (datetime "2022-05-01")) 1)))
+
+  (parameterize ((week-start mon))
+    (cal-table start-date: #2022-04-01 end-date: #2022-04-30 next-start: month+ prev-start: month-)))
+
diff --git a/tests/test/html/component.scm b/tests/test/html/component.scm
new file mode 100644
index 00000000..97581c50
--- /dev/null
+++ b/tests/test/html/component.scm
@@ -0,0 +1,59 @@
+(define-module (test html caltable)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-64 test-error)
+  :use-module (srfi srfi-88)
+  :use-module (calp translation)
+
+  :use-module (calp html components)
+  )
+
+(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
+                          body))
+  (xhtml-doc body))
+
+(test-equal '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+                    (html (@ (xmlns "http://www.w3.org/1999/xhtml"))
+                          (b "Hello, World!")))
+  (xhtml-doc ,'(b "Hello, World!")))
+
+(test-equal
+    '(*TOP* (*PI* xml "version=\"1.0\" encoding=\"utf-8\"")
+            (html (@ (xmlns "http://www.w3.org/1999/xhtml")
+                     (lang sv))
+                  body))
+    (xhtml-doc (@ (lang sv)) body))
+
+
+;; TODO Slider not tested, due to depending on gensyms, and really needing
+;;      integration testing to be worth anything.
+
+
+(test-equal
+    '(button (@ (class "btn") (onclick "onclick")) "Body")
+  (btn onclick: "onclick" "Body"))
+
+(test-equal "href button, without body"
+    '(a (@ (class "btn") (href "href")) #f)
+  (btn href: "href"))
+
+(test-error 'wrong-type-arg
+  (btn href: "a" onclick: "b"))
+
+(test-equal "btn no specifier, but class"
+  '(button (@ (class "btn test")) "body")
+  (btn class: '("test") "body"))
+
+;; tabset
+;; with-label
+
+(test-equal '(link (@ (type "text/css") (rel "stylesheet") (href "style.css")))
+  (include-css "style.css"))
+
+(test-equal
+    '(link (@ (type "text/css") (rel "stylesheet") (href "style.css") (class "test")))
+  (include-css "style.css" '(class "test")))
+
+(test-equal
+    '(link (@ (type "text/css") (rel "alternate stylesheet") (href "style.css")))
+  (include-alt-css "style.css"))
diff --git a/tests/test/recurrence-advanced.scm b/tests/test/recurrence-advanced.scm
index 9ea1e075..aefe1ace 100644
--- a/tests/test/recurrence-advanced.scm
+++ b/tests/test/recurrence-advanced.scm
@@ -58,7 +58,10 @@
   (test-equal
     (string-append "STR: " (prop comp 'SUMMARY))
     (prop comp 'X-SUMMARY)
-    (format-recurrence-rule (prop comp 'RRULE))))
+    ;; TODO setting language='en causes messages to be in english, but date
+    ;; strings still format LC_TIME (which I have set to swedish)...
+    ;; TODO possibly test with other languages
+    (format-recurrence-rule (prop comp 'RRULE) 'sv)))
 
 (define (vevent . rest)
   (define v (make-vcomponent 'VEVENT))
@@ -1342,6 +1345,33 @@
                    #2005-05-16T09:00:00
                    #2005-05-18T09:00:00
                    #2006-05-15T09:00:00
-                   #2006-05-17T09:00:00))))
+                   #2006-05-17T09:00:00))
+           (vevent
+            summary: "Each second, for ever"
+            dtstart: "20201010T100000"
+            rrule: "FREQ=SECONDLY"
+            x-summary: "varje sekund"
+            x-set: (list #2020-10-10T10:00:00
+                         #2020-10-10T10:00:01
+                         #2020-10-10T10:00:02
+                         #2020-10-10T10:00:03
+                         #2020-10-10T10:00:04
+                         #2020-10-10T10:00:05
+                         #2020-10-10T10:00:06
+                         #2020-10-10T10:00:07
+                         #2020-10-10T10:00:08
+                         #2020-10-10T10:00:09
+                         #2020-10-10T10:00:10
+                         #2020-10-10T10:00:11
+                         #2020-10-10T10:00:12
+                         #2020-10-10T10:00:13
+                         #2020-10-10T10:00:14
+                         #2020-10-10T10:00:15
+                         #2020-10-10T10:00:16
+                         #2020-10-10T10:00:17
+                         #2020-10-10T10:00:18
+                         #2020-10-10T10:00:19))
+
+           ))
 
 
diff --git a/tests/test/srfi-41-util.scm b/tests/test/srfi-41-util.scm
index 176fb38e..12eccac5 100644
--- a/tests/test/srfi-41-util.scm
+++ b/tests/test/srfi-41-util.scm
@@ -6,14 +6,8 @@
 (define-module (test srfi-41-util)
   :use-module (srfi srfi-64)
   :use-module (srfi srfi-88)
-  :use-module ((srfi srfi-41 util) :select (stream-paginate))
-  :use-module ((srfi srfi-41)
-               :select (stream->list
-                        stream-ref
-                        stream-from
-                        stream-filter
-                        stream-car
-                        stream))
+  :use-module (srfi srfi-41 util)
+  :use-module (srfi srfi-41)
   :use-module ((ice-9 sandbox) :select (call-with-time-limit)))
 
 (test-equal "Finite stream"
@@ -42,3 +36,51 @@
      (lambda _ unique-symbol))))
 
 
+
+
+(test-equal "stream insert"
+  '(1 4 5 7 8)
+  (stream->list (stream-insert < 5 (stream 1 4 7 8))))
+
+
+(test-equal "Filter sorted stream"
+  '(4 6 8)
+  (stream->list (filter-sorted-stream even? (stream 1 3 4 6 8 9 11))))
+
+(test-equal "Filter sorted stream (which actually is unsorted)"
+  '(4 6 8)
+  (stream->list (filter-sorted-stream even? (stream 1 3 4 6 8 9 11 12))))
+
+;; TODO filter-sorted-stream*
+
+(test-equal
+    "Get stream interval"
+    '(5 6 7 8 9)
+    (stream->list (get-stream-interval (lambda (x) (< 4 x))
+                                       (lambda (x) (< x 10))
+                                       (stream 1 2 3 4 5 6 7 8 9 10 11 12))))
+
+
+
+(test-equal "stream find" 2 (stream-find even? (stream-from 1)))
+
+
+(test-equal
+    "repeating naturals"
+    '(1 1 1 2 2 2 3 3 3 4)
+    (stream->list 10 (repeating-naturals 1 3)))
+
+
+;; sleep will return early if a singal arrives, this just resumes sleeping until
+;; the wanted time is hit.
+;; Might sleep longer since sleep always returns a whole number of seconds remaining
+(define (true-sleep n)
+  (let loop ((remaining n))
+    (unless (zero? remaining)
+      (loop (sleep remaining)))))
+
+(let ((strm (stream-map (lambda (x) (when (zero? (modulo x 4)) (true-sleep 1)) x) (stream-from 1))))
+  (let ((strm (stream-timeslice-limit strm 0.1)))
+    (test-equal "time limited stream"
+      '(1 2 3)
+      (stream->list strm))))
diff --git a/tests/test/translation.scm b/tests/test/translation.scm
new file mode 100644
index 00000000..5fb32ab0
--- /dev/null
+++ b/tests/test/translation.scm
@@ -0,0 +1,15 @@
+(define-module (test translation)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module (calp translation)
+  :use-module (ice-9 i18n))
+
+(define sv (make-locale (list LC_CTYPE LC_MESSAGES) "sv_SE.UTF-8"))
+
+;; empty key should give us translation header
+;; this also tests that translations are properly loaded
+(test-assert "translations" (string? (translate "")))
+
+(test-equal "yes-no yes" 'yes (yes-no-check "y" sv))
+(test-equal "yes-no no" 'no (yes-no-check "n" sv))
+(test-equal "yes-no invalid" #f (yes-no-check "other" sv))
diff --git a/tests/test/util.scm b/tests/test/util.scm
index 325ca992..95fa8da0 100644
--- a/tests/test/util.scm
+++ b/tests/test/util.scm
@@ -6,19 +6,138 @@
   :use-module (srfi srfi-64)
   :use-module (srfi srfi-64 test-error)
   :use-module (srfi srfi-88)
-  :use-module ((hnh util)
-               :select (filter-sorted
-                        set/r!
-                        find-min
-                        find-max
-                        find-extreme
-                        span-upto
-                        iterate
-                        ->string
-                        ->quoted-string
-                        begin1))
+  :use-module (srfi srfi-1)
+  :use-module (hnh util)
   :use-module ((hnh util path)
-               :select (path-append path-split)))
+               :select (path-append path-split file-hidden?)))
+
+(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 "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-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"
@@ -149,4 +268,7 @@
   '("" "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? "")))
diff --git a/tests/test/uuid.scm b/tests/test/uuid.scm
new file mode 100644
index 00000000..6a2bd92a
--- /dev/null
+++ b/tests/test/uuid.scm
@@ -0,0 +1,12 @@
+(define-module (test uuid)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-64 test-error)
+  :use-module (srfi srfi-88)
+  :use-module (hnh util uuid))
+
+(set! (@@ (hnh util uuid) %seed)
+  (seed->random-state 0))
+
+(test-equal "UUIDv4 fixed seed"
+  "d19c9347-9a85-4432-a876-5fb9c0d24d2b"
+  (uuid-v4))
-- 
cgit v1.2.3