diff options
Diffstat (limited to 'tests/test')
-rw-r--r-- | tests/test/crypto.scm | 3 | ||||
-rw-r--r-- | tests/test/datetime.scm | 214 | ||||
-rw-r--r-- | tests/test/html/caltable.scm | 105 | ||||
-rw-r--r-- | tests/test/html/component.scm | 59 | ||||
-rw-r--r-- | tests/test/recurrence-advanced.scm | 34 | ||||
-rw-r--r-- | tests/test/srfi-41-util.scm | 58 | ||||
-rw-r--r-- | tests/test/translation.scm | 15 | ||||
-rw-r--r-- | tests/test/util.scm | 148 | ||||
-rw-r--r-- | tests/test/uuid.scm | 12 |
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)) |