From 1e8171b95e146b18c2c173445bd34dc3cacee3af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 22 Oct 2023 14:52:08 +0200 Subject: Test work. --- module/datetime.scm | 18 ++- tests/unit/coverage-supplement.scm | 78 +++++++++++- tests/unit/datetime/datetime.scm | 245 +++++++++++++++++++++++++++++++------ tests/unit/util/hnh-util.scm | 10 +- tests/unit/util/srfi-41-util.scm | 12 +- 5 files changed, 314 insertions(+), 49 deletions(-) diff --git a/module/datetime.scm b/module/datetime.scm index d54ba403..9bb536e3 100644 --- a/module/datetime.scm +++ b/module/datetime.scm @@ -737,12 +737,16 @@ Returns -1 on failure" (loop* str fmt dt ampm)) (cond [(and (null? str) (null? fmt)) - (ampm dt)] + (if return-trailing + (values (ampm dt) '()) + (ampm dt))] [(null? str) ;; TODO it would be preferable to error out here. However, that fails for ;; optional specifiers (e.g. ~Z). ;; Also see the disabled test in "Premature end of string to parse" - (ampm dt) + (if return-trailing + (values (ampm dt) '()) + (ampm dt)) #; (err "Premature end of string, trailing fmt: ~s" fmt)] [(null? fmt) (if return-trailing @@ -842,11 +846,17 @@ Returns -1 on failure" (define* (string->time str optional: (fmt "~H:~M:~S") (locale %global-locale) key: return-trailing) - (datetime-time (string->datetime str fmt locale return-trailing: return-trailing))) + (call-with-values + (lambda () (string->datetime str fmt locale return-trailing: return-trailing)) + (case-lambda ((dt) (datetime-time dt)) + ((dt rem) (values (datetime-time dt) rem))))) (define* (string->date str optional: (fmt "~Y-~m-~d") (locale %global-locale) key: return-trailing) - (datetime-date (string->datetime str fmt locale return-trailing: return-trailing))) + (call-with-values + (lambda () (string->datetime str fmt locale return-trailing: return-trailing)) + (case-lambda ((dt) (datetime-date dt)) + ((dt rem) (values (datetime-time dt) rem))))) ;; Parse @var{string} as either a date, time, or date-time. ;; String MUST be on iso-8601 format. diff --git a/tests/unit/coverage-supplement.scm b/tests/unit/coverage-supplement.scm index e9dff8f2..288eeda2 100644 --- a/tests/unit/coverage-supplement.scm +++ b/tests/unit/coverage-supplement.scm @@ -28,8 +28,8 @@ ("module/base64.scm" "4614855f6cfedc20041e7094989e817f2c2c5ef85fb5f8322d915101c0aab53c" 1 ; module declaration - 23 29 ; internal lookup table, used by everything so tested implicitly - 53 ; internal helper function, tested implictly + 23 24 25 26 27 29 ; internal lookup table, used by everything so tested implicitly + 53 54 55 56 ; internal helper function, tested implictly ) ("module/text/util.scm" "271a5f7740aa6e378e7fda2da4725171dc50a2e4a790e9529fceed19a747e775" @@ -42,4 +42,78 @@ 113 114 115 118 119 120 121 ) + ("module/calp.scm" + "873a191bc7122e59e3d60fb0f075dfa73fd8cc5ae0f3cb51932b24a0497ceeb1" + 1 ; Modudule declaration + 5 ; Version number (global variables are missed by the coverage) + ) + ("module/crypto.scm" + "9e157f5b53e923e7925b0e53118a4789b55712120427b73c4c3c9561e2c48718" + 1 ; Module declaration + 8 ; dynamic link + 10 11 12 13 14 ; constants + 16 17 18 19 ; primitive sha256 procedure + ) + ("module/datetime.scm" + "67eb46283a4097e8400322ab6434518a2455ca630e163238b5839c2bf25c9ac7" + 1 + 159 160 161 162 163 164 165 ; week day declarations + ;; function declarations + 189 223 238 389 909 + 965 966 974 + 987 992 1011 1025 + 1231 + 1239 1280 + 923 924 925 ; read-hash-extend + ;; aliases + 958 959 960 + 1029 1031 1032 1034 1036 1037 1039 1041 1042 1044 1046 1047 + 1049 1051 1052 1054 1056 1057 1059 1061 1062 1064 1065 1067 1068 + ;; other + 204 + 252 ; Would depend on local timezone + 491 ; somehow not counted + ) + + ("module/datetime/zic.scm" + "2a8ac0fae3c88227b05a5978bff3e114745ea146e07a2751df67d16c1e8218f5" + 13 ; module declaration + 66 ; syntax-rules + 171 223 ; function declaration + ) + + ("module/datetime/timespec.scm" + "9feb7a7a09d9942d72c6b14b9f230e7711a73ca518ec2dc209775354203d856b" + 6 ; module declaration + ) + + ("module/hnh/util.scm" + "3f0bf90a45d6eecce1248b7509e1b050e5cadbe92b279fe5ef082c18baf3e6ca" + 1 + 72 73 74 ; conditional import + 77 ; syntax rules not covered:w + 289 ; != definition + 333 488 568 ; syntax rules + ) + + ("module/srfi/srfi-41/util.scm" + "adb832b17f7ffe7c070fa3845f65283e850b14a07499d22715e16111f59ad88e" + 1) + + + ;; this file simply exports other things. There's nothing to test + ("module/vcomponent.scm" + "b1c58b3beb6f170d3c9f7d603b27231ccf696897736113095b446f437721a9e1" + 2) + + +;;; Vendored files, and therefore shouldn't be tested + + ("module/srfi/srfi-64/test-error.scm" + "15a0eb700de629a9e79aec8a1fde113fbc9542d052163ede46b433d630b7b01c" + 2) + + ("module/sxml/html.scm" + "b4ffca46c9c723f6828e32d8798f1bbc89c2bfcb6f1368906b2d4bdef11951db" + 2) ) diff --git a/tests/unit/datetime/datetime.scm b/tests/unit/datetime/datetime.scm index 9f32d4a1..650eea02 100644 --- a/tests/unit/datetime/datetime.scm +++ b/tests/unit/datetime/datetime.scm @@ -204,7 +204,27 @@ (datetime month: may) (string->datetime "Maj" "~h" sv_SE))) - ;; TODO AM/PM string ~p + (test-group "AM/PM" + (test-equal "AM (and no periods)" + (time hour: 10) + (string->time "10 AM" "~H ~p")) + (test-equal "PM (and periods)" + (time hour: 22) + (string->time "10 p.m." "~H ~p")) + (test-group "Period after AM/PM" + (call-with-values + (lambda () + (string->time "Meeting at 12 pm." "Meeting at ~H ~p." + return-trailing: #t)) + (lambda (dt trailing) + (test-equal "Trailing period" + (time hour: 12) dt) + (test-equal "No remaining items" + '() trailing)))) + (test-equal "12 am is midnight" + (time hour: 0) + (string->time "12 AM" "~H ~p")) + ) (test-group "Complete parses" (test-equal "Parse complete ISO date" @@ -388,11 +408,38 @@ (date? (current-date))) -;; TODO write these, also, check connection to get-time% -get-datetime -as-date -as-time -as-datetime +(test-group "as-date" + (test-equal (date year: 1 month: 2 day: 3) + (as-date (datetime year: 1 month: 2 day: 3 + hour: 4 minute: 5 second: 6))) + (test-equal (date year: 1 month: 2 day: 3) + (as-date (date year: 1 month: 2 day: 3))) + (test-equal (date) (as-date (time hour: 1 minute: 2 second: 3))) + (test-error 'wrong-type-arg + (as-date 'something-else))) + +(test-group "as-time" + (test-equal (time hour: 4 minute: 5 second: 6) + (as-time (datetime year: 1 month: 2 day: 3 + hour: 4 minute: 5 second: 6))) + (test-equal (time hour: 1 minute: 2 second: 3) + (as-time (time hour: 1 minute: 2 second: 3))) + (test-equal (time) (as-time (date year: 1 month: 2 day: 3))) + (test-error 'wrong-type-arg + (as-time 'something-else))) + +(test-group "as-datetime" + (test-equal (datetime year: 1 month: 2 day: 3 + hour: 4 minute: 5 second: 6) + (as-datetime (datetime year: 1 month: 2 day: 3 + hour: 4 minute: 5 second: 6))) + (test-equal (datetime year: 1 month: 2 day: 3) + (as-datetime (date year: 1 month: 2 day: 3))) + (test-equal (datetime hour: 1 minute: 2 second: 3) + (as-datetime (time hour: 1 minute: 2 second: 3))) + (test-error 'wrong-type-arg + (as-datetime 'something-else))) + (test-group "Leap years" (test-assert "Most years are't leap years" (not (leap-year? 1999))) @@ -448,11 +495,20 @@ as-datetime (test-equal "Week day" thu (week-day (date year: 2022 month: 06 day: 23))) -(test-equal "week-1-start" (date year: 2019 month: 12 day: 30) (week-1-start (date year: 2020 month: 01 day: 01) mon)) - -;; Possibly add case where the end of the year uses next years week numbers -(test-equal "Week number at end of year" 53 (week-number (date year: 2008 month: 12 day: 31) sun)) -(test-equal "Week number at start of year" 53 (week-number (date year: 2009 month: 01 day: 01) sun)) +(test-group "week-1-start" + (test-equal + (date year: 2019 month: 12 day: 30) + (week-1-start (date year: 2020) + mon)) + (test-equal + (date year: 2018 month: 1 day: 1) + (week-1-start (date year: 2018) + mon))) + +(test-group "week-number" + (test-equal "Week number at end of year" 53 (week-number (date year: 2008 month: 12 day: 31) sun)) + (test-equal "Week number at start of year" 53 (week-number (date year: 2009 month: 01 day: 01) sun)) + (test-equal "Week using next years weeks" 1 (week-number (date year: 2018 month: 12 day: 31) mon))) (test-equal (date year: 2008 month: 12 day: 28) (date-starting-week 53 (date year: 2008) sun)) (test-equal (date year: 2007 month: 12 day: 30) (date-starting-week 1 (date year: 2008) sun)) @@ -472,35 +528,39 @@ as-datetime ;; | ||s2| : |s1|| | : | || | : | || | : | || | : ;; | | : | | : | || | : | || | : | || | : |s2| ;; | | : | | : | | : | | : : | | - (test-assert "End of S1 overlaps start of S2" - (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) - (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00))) - (test-assert "Start of S1 overlaps end of S2" - (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00) - (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) - (test-assert "S1 complete encompasses S2" - (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00) - (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) - (test-assert "S2 complete encompasses S1" - (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) - (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00))) - (test-assert "S1 is equal to S2" - (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) - (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) - (test-assert "S1 dosesn't overlap S2" + (test-assert "[A] End of S1 overlaps start of S2" + (timespan-overlaps? (time hour: 10) (time hour: 12) + (time hour: 11) (time hour: 13))) + (test-assert "[B] Start of S1 overlaps end of S2" + (timespan-overlaps? (time hour: 11) (time hour: 13) + (time hour: 10) (time hour: 12))) + (test-assert "[C] S1 complete encompasses S2" + (timespan-overlaps? (time hour: 10) (time hour: 13) + (time hour: 11) (time hour: 12))) + (test-assert "[D] S2 complete encompasses S1" + (timespan-overlaps? (time hour: 11) (time hour: 12) + (time hour: 10) (time hour: 13))) + (test-assert "[E] S1 is equal to S2" + (timespan-overlaps? (time hour: 11) (time hour: 12) + (time hour: 11) (time hour: 12))) + (test-assert "[F] S1 dosesn't overlap S2" (not - (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 11 minute: 00 second: 00) - (time hour: 12 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)))) + (timespan-overlaps? (time hour: 10) (time hour: 11) + (time hour: 12) (time hour: 13)))) (test-assert "If the events only share an instant they don't overlap" (not - (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) - (time hour: 12 minute: 00 second: 00) (time hour: 14 minute: 00 second: 00))))) + (timespan-overlaps? (time hour: 10) (time hour: 12) + (time hour: 12) (time hour: 14))))) -(test-equal (date year: 2022 month: 06 day: 25) (find-first-week-day sat (date year: 2022 month: 06 day: 23))) +(test-equal (date year: 2022 month: 06 day: 25) + (find-first-week-day sat (date year: 2022 month: 06 day: 23))) (test-group "All weekdays in <>" (test-equal "month, if starting from beginning of month" - (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24)) + (list (date year: 2022 month: 06 day: 03) + (date year: 2022 month: 06 day: 10) + (date year: 2022 month: 06 day: 17) + (date year: 2022 month: 06 day: 24)) (all-wday-in-month fri (date year: 2022 month: 06 day: 01))) (test-equal "month, if starting from the middle" @@ -508,15 +568,101 @@ as-datetime (all-wday-in-month fri (date year: 2022 month: 06 day: 23))) (test-equal "year, if starting from the beggining" - (list (date year: 2022 month: 01 day: 07) (date year: 2022 month: 01 day: 14) (date year: 2022 month: 01 day: 21) (date year: 2022 month: 01 day: 28) (date year: 2022 month: 02 day: 04) (date year: 2022 month: 02 day: 11) (date year: 2022 month: 02 day: 18) (date year: 2022 month: 02 day: 25) (date year: 2022 month: 03 day: 04) (date year: 2022 month: 03 day: 11) (date year: 2022 month: 03 day: 18) (date year: 2022 month: 03 day: 25) (date year: 2022 month: 04 day: 01) (date year: 2022 month: 04 day: 08) (date year: 2022 month: 04 day: 15) (date year: 2022 month: 04 day: 22) (date year: 2022 month: 04 day: 29) (date year: 2022 month: 05 day: 06) (date year: 2022 month: 05 day: 13) (date year: 2022 month: 05 day: 20) (date year: 2022 month: 05 day: 27) (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30)) + (list (date year: 2022 month: 01 day: 07) + (date year: 2022 month: 01 day: 14) + (date year: 2022 month: 01 day: 21) + (date year: 2022 month: 01 day: 28) + (date year: 2022 month: 02 day: 04) + (date year: 2022 month: 02 day: 11) + (date year: 2022 month: 02 day: 18) + (date year: 2022 month: 02 day: 25) + (date year: 2022 month: 03 day: 04) + (date year: 2022 month: 03 day: 11) + (date year: 2022 month: 03 day: 18) + (date year: 2022 month: 03 day: 25) + (date year: 2022 month: 04 day: 01) + (date year: 2022 month: 04 day: 08) + (date year: 2022 month: 04 day: 15) + (date year: 2022 month: 04 day: 22) + (date year: 2022 month: 04 day: 29) + (date year: 2022 month: 05 day: 06) + (date year: 2022 month: 05 day: 13) + (date year: 2022 month: 05 day: 20) + (date year: 2022 month: 05 day: 27) + (date year: 2022 month: 06 day: 03) + (date year: 2022 month: 06 day: 10) + (date year: 2022 month: 06 day: 17) + (date year: 2022 month: 06 day: 24) + (date year: 2022 month: 07 day: 01) + (date year: 2022 month: 07 day: 08) + (date year: 2022 month: 07 day: 15) + (date year: 2022 month: 07 day: 22) + (date year: 2022 month: 07 day: 29) + (date year: 2022 month: 08 day: 05) + (date year: 2022 month: 08 day: 12) + (date year: 2022 month: 08 day: 19) + (date year: 2022 month: 08 day: 26) + (date year: 2022 month: 09 day: 02) + (date year: 2022 month: 09 day: 09) + (date year: 2022 month: 09 day: 16) + (date year: 2022 month: 09 day: 23) + (date year: 2022 month: 09 day: 30) + (date year: 2022 month: 10 day: 07) + (date year: 2022 month: 10 day: 14) + (date year: 2022 month: 10 day: 21) + (date year: 2022 month: 10 day: 28) + (date year: 2022 month: 11 day: 04) + (date year: 2022 month: 11 day: 11) + (date year: 2022 month: 11 day: 18) + (date year: 2022 month: 11 day: 25) + (date year: 2022 month: 12 day: 02) + (date year: 2022 month: 12 day: 09) + (date year: 2022 month: 12 day: 16) + (date year: 2022 month: 12 day: 23) + (date year: 2022 month: 12 day: 30)) (all-wday-in-year fri (date year: 2022 month: 01 day: 01))) (test-equal "year, if starting from the middle" - (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30)) + (list (date year: 2022 month: 06 day: 03) + (date year: 2022 month: 06 day: 10) + (date year: 2022 month: 06 day: 17) + (date year: 2022 month: 06 day: 24) + (date year: 2022 month: 07 day: 01) + (date year: 2022 month: 07 day: 08) + (date year: 2022 month: 07 day: 15) + (date year: 2022 month: 07 day: 22) + (date year: 2022 month: 07 day: 29) + (date year: 2022 month: 08 day: 05) + (date year: 2022 month: 08 day: 12) + (date year: 2022 month: 08 day: 19) + (date year: 2022 month: 08 day: 26) + (date year: 2022 month: 09 day: 02) + (date year: 2022 month: 09 day: 09) + (date year: 2022 month: 09 day: 16) + (date year: 2022 month: 09 day: 23) + (date year: 2022 month: 09 day: 30) + (date year: 2022 month: 10 day: 07) + (date year: 2022 month: 10 day: 14) + (date year: 2022 month: 10 day: 21) + (date year: 2022 month: 10 day: 28) + (date year: 2022 month: 11 day: 04) + (date year: 2022 month: 11 day: 11) + (date year: 2022 month: 11 day: 18) + (date year: 2022 month: 11 day: 25) + (date year: 2022 month: 12 day: 02) + (date year: 2022 month: 12 day: 09) + (date year: 2022 month: 12 day: 16) + (date year: 2022 month: 12 day: 23) + (date year: 2022 month: 12 day: 30)) (all-wday-in-year fri (date year: 2022 month: 06 day: 01)))) -;; TODO -in-date-range? +(test-group "in-date-range?" + (let ((f (in-date-range? (date year: 2020 month: 1 day: 1) + (date year: 2021 month: 1 day: 1)))) + (test-assert "Midle of interval" (f (date year: 2020 month: 5))) + (test-assert "Left edge" (f (date year: 2020 month: 1 day: 1))) + (test-assert "Right edge" (f (date year: 2021 month: 1 day: 1))) + (test-assert "Outside" (not (f (date year: 2019 month: 1 day: 1)))))) (test-equal "weekday-list" (list wed thu fri sat sun mon tue) (weekday-list wed)) (test-equal "start of week" (date year: 2022 month: 06 day: 20) (start-of-week (date year: 2022 month: 06 day: 23) mon)) @@ -552,8 +698,29 @@ in-date-range? (test-equal "Can get length of month if we have a month" (* 31 24.0) (datetime->decimal-hour (datetime month: 1) (date year: 2020 month: 01 day: 01))))) -;; TODO -date-range +(test-equal "date-range" + (list (date year: 2020 month: 01 day: 01) + (date year: 2020 month: 01 day: 03) + (date year: 2020 month: 01 day: 05) + (date year: 2020 month: 01 day: 07) + (date year: 2020 month: 01 day: 09) + (date year: 2020 month: 01 day: 11) + (date year: 2020 month: 01 day: 13) + (date year: 2020 month: 01 day: 15) + (date year: 2020 month: 01 day: 17) + (date year: 2020 month: 01 day: 19) + (date year: 2020 month: 01 day: 21) + (date year: 2020 month: 01 day: 23) + (date year: 2020 month: 01 day: 25) + (date year: 2020 month: 01 day: 27) + (date year: 2020 month: 01 day: 29) + (date year: 2020 month: 01 day: 31)) + (date-range (date year: 2020 month: 1 day: 1) + ;; This is an invalid date, but it tests how "invalid" input is handled. + (date year: 2020 month: 1 day: 100) + (date day: 2))) + + (test-group "To string" (test-group "Datetime->string" diff --git a/tests/unit/util/hnh-util.scm b/tests/unit/util/hnh-util.scm index 8586b6d9..79b86b54 100644 --- a/tests/unit/util/hnh-util.scm +++ b/tests/unit/util/hnh-util.scm @@ -202,7 +202,11 @@ (!= 1 2))) (test-group "init+last" - 'TODO) + (call-with-values + (lambda () (init+last (iota 5))) + (lambda (init last) + (test-equal '(0 1 2 3) init) + (test-equal 4 last)))) (test-group "take-to" (test-equal "Take to" @@ -336,6 +340,10 @@ (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))))) (test-group "cross-product" + + (test-equal "null case" + '() (cross-product)) + (test-equal "Basic case" '((1 4) (1 5) diff --git a/tests/unit/util/srfi-41-util.scm b/tests/unit/util/srfi-41-util.scm index 79c607c5..8e1b79d8 100644 --- a/tests/unit/util/srfi-41-util.scm +++ b/tests/unit/util/srfi-41-util.scm @@ -4,13 +4,19 @@ ;;; Code: (define-module (test srfi-41-util) - :use-module (srfi srfi-64) - :use-module (srfi srfi-88) + :use-module ((srfi srfi-1) :select (circular-list)) :use-module (srfi srfi-41 util) :use-module (srfi srfi-41) - :use-module ((srfi srfi-1) :select (circular-list)) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) :use-module ((ice-9 sandbox) :select (call-with-time-limit))) +(test-group "stream car+cdr" + (let ((a d (stream-car+cdr (stream 1 2 3)))) + (test-equal "car" 1 a) + (test-equal "cdr" '(2 3) (stream->list d)))) + (test-equal "Finite stream" '((0 1 2) (3 4 5) (6 7 8) (9)) (let ((strm (stream-paginate (stream 0 1 2 3 4 5 6 7 8 9) 3))) -- cgit v1.2.3