aboutsummaryrefslogtreecommitdiff
path: root/tests/test
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2022-04-12 13:30:32 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2022-04-21 21:16:45 +0200
commited4281ff072443167c43207c039570126061d23b (patch)
tree3c5c0c73a43935d19cc12bd39036b08b7dd4230b /tests/test
parentAllow tests in subdirs. (diff)
downloadcalp-ed4281ff072443167c43207c039570126061d23b.tar.gz
calp-ed4281ff072443167c43207c039570126061d23b.tar.xz
Add a lot of new unit tests.
Diffstat (limited to 'tests/test')
-rw-r--r--tests/test/crypto.scm3
-rw-r--r--tests/test/datetime.scm214
-rw-r--r--tests/test/html/caltable.scm105
-rw-r--r--tests/test/html/component.scm59
-rw-r--r--tests/test/recurrence-advanced.scm34
-rw-r--r--tests/test/srfi-41-util.scm58
-rw-r--r--tests/test/translation.scm15
-rw-r--r--tests/test/util.scm148
-rw-r--r--tests/test/uuid.scm12
9 files changed, 614 insertions, 34 deletions
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))