Artifact
2ca3030c1a7aaffec76cdbff0daebe36dd687d10:
- File
srfi/tests/time.sps
— part of check-in
[80c8c83034]
at
2016-07-07 18:11:39
on branch trunk
— initial import
(user:
ovenpasta@pizzahack.eu
size: 8743)
0000: 3b 3b 3b 20 73 69 6d 70 6c 65 20 74 65 73 74 20 ;;; simple test
0010: 70 72 6f 63 65 64 75 72 65 73 0a 23 21 72 36 72 procedures.#!r6r
0020: 73 0a 28 69 6d 70 6f 72 74 0a 20 20 28 72 6e 72 s.(import. (rnr
0030: 73 29 0a 20 20 28 72 6e 72 73 20 6d 75 74 61 62 s). (rnrs mutab
0040: 6c 65 2d 70 61 69 72 73 29 0a 20 20 28 73 75 72 le-pairs). (sur
0050: 66 61 67 65 20 73 31 39 20 74 69 6d 65 29 0a 20 fage s19 time).
0060: 20 28 73 75 72 66 61 67 65 20 73 34 38 20 69 6e (surfage s48 in
0070: 74 65 72 6d 65 64 69 61 74 65 2d 66 6f 72 6d 61 termediate-forma
0080: 74 2d 73 74 72 69 6e 67 73 29 29 0a 0a 28 64 65 t-strings))..(de
0090: 66 69 6e 65 20 28 70 72 69 6e 74 66 20 66 6d 74 fine (printf fmt
00a0: 2d 73 74 72 20 2e 20 61 72 67 73 29 0a 20 20 28 -str . args). (
00b0: 64 69 73 70 6c 61 79 20 28 61 70 70 6c 79 20 66 display (apply f
00c0: 6f 72 6d 61 74 20 66 6d 74 2d 73 74 72 20 61 72 ormat fmt-str ar
00d0: 67 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 73 gs)))..(define s
00e0: 31 39 2d 74 65 73 74 73 20 28 6c 69 73 74 29 29 19-tests (list))
00f0: 0a 0a 28 64 65 66 69 6e 65 20 28 64 65 66 69 6e ..(define (defin
0100: 65 2d 73 31 39 2d 74 65 73 74 21 20 6e 61 6d 65 e-s19-test! name
0110: 20 74 68 75 6e 6b 29 0a 20 20 28 6c 65 74 20 28 thunk). (let (
0120: 28 6e 61 6d 65 20 28 69 66 20 28 73 79 6d 62 6f (name (if (symbo
0130: 6c 3f 20 6e 61 6d 65 29 20 6e 61 6d 65 20 28 73 l? name) name (s
0140: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 6e 61 tring->symbol na
0150: 6d 65 29 29 29 0a 09 28 70 72 20 28 61 73 73 6f me)))..(pr (asso
0160: 63 20 6e 61 6d 65 20 73 31 39 2d 74 65 73 74 73 c name s19-tests
0170: 29 29 29 0a 20 20 20 20 28 69 66 20 70 72 0a 09 ))). (if pr..
0180: 28 73 65 74 2d 63 64 72 21 20 70 72 20 74 68 75 (set-cdr! pr thu
0190: 6e 6b 29 0a 09 28 73 65 74 21 20 73 31 39 2d 74 nk)..(set! s19-t
01a0: 65 73 74 73 20 28 61 70 70 65 6e 64 20 73 31 39 ests (append s19
01b0: 2d 74 65 73 74 73 20 28 6c 69 73 74 20 28 63 6f -tests (list (co
01c0: 6e 73 20 6e 61 6d 65 20 74 68 75 6e 6b 29 29 29 ns name thunk)))
01d0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 ))))..(define (r
01e0: 75 6e 2d 73 31 39 2d 74 65 73 74 20 6e 61 6d 65 un-s19-test name
01f0: 20 74 68 75 6e 6b 20 76 65 72 62 6f 73 65 29 0a thunk verbose).
0200: 20 20 28 69 66 20 76 65 72 62 6f 73 65 20 28 62 (if verbose (b
0210: 65 67 69 6e 20 28 64 69 73 70 6c 61 79 20 22 3b egin (display ";
0220: 3b 3b 20 52 75 6e 6e 69 6e 67 20 22 29 20 28 64 ;; Running ") (d
0230: 69 73 70 6c 61 79 20 6e 61 6d 65 29 29 29 0a 20 isplay name))).
0240: 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 28 (let ((result (
0250: 74 68 75 6e 6b 29 29 29 0a 20 20 20 20 28 69 66 thunk))). (if
0260: 20 76 65 72 62 6f 73 65 20 28 62 65 67 69 6e 20 verbose (begin
0270: 28 64 69 73 70 6c 61 79 20 22 3a 20 22 29 20 28 (display ": ") (
0280: 64 69 73 70 6c 61 79 20 28 6e 6f 74 20 28 6e 6f display (not (no
0290: 74 20 72 65 73 75 6c 74 29 29 29 20 28 6e 65 77 t result))) (new
02a0: 6c 69 6e 65 29 29 29 0a 20 20 20 20 72 65 73 75 line))). resu
02b0: 6c 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 72 lt))..(define (r
02c0: 75 6e 2d 73 31 39 2d 74 65 73 74 73 20 2e 20 76 un-s19-tests . v
02d0: 65 72 62 6f 73 65 29 0a 20 20 28 6c 65 74 20 28 erbose). (let (
02e0: 28 72 75 6e 73 20 30 29 20 28 67 6f 6f 64 73 20 (runs 0) (goods
02f0: 30 29 20 28 62 61 64 73 20 30 29 20 28 76 65 72 0) (bads 0) (ver
0300: 62 6f 73 65 20 28 69 66 20 28 63 64 72 20 76 65 bose (if (cdr ve
0310: 72 62 6f 73 65 29 20 28 63 64 72 20 76 65 72 62 rbose) (cdr verb
0320: 6f 73 65 29 20 23 66 29 29 29 0a 20 20 20 20 28 ose) #f))). (
0330: 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 61 for-each (lambda
0340: 20 28 70 72 29 0a 09 09 28 73 65 74 21 20 72 75 (pr)...(set! ru
0350: 6e 73 20 28 2b 20 72 75 6e 73 20 31 29 29 0a 09 ns (+ runs 1))..
0360: 09 28 69 66 20 28 72 75 6e 2d 73 31 39 2d 74 65 .(if (run-s19-te
0370: 73 74 20 28 63 61 72 20 70 72 29 20 28 63 64 72 st (car pr) (cdr
0380: 20 70 72 29 20 76 65 72 62 6f 73 65 29 0a 09 09 pr) verbose)...
0390: 20 20 20 20 28 73 65 74 21 20 67 6f 6f 64 73 20 (set! goods
03a0: 28 2b 20 67 6f 6f 64 73 20 31 29 29 0a 09 09 20 (+ goods 1))...
03b0: 20 20 20 28 73 65 74 21 20 62 61 64 73 20 28 2b (set! bads (+
03c0: 20 62 61 64 73 20 31 29 29 29 29 0a 09 20 20 20 bads 1))))..
03d0: 20 20 20 73 31 39 2d 74 65 73 74 73 29 0a 20 20 s19-tests).
03e0: 20 20 28 69 66 20 76 65 72 62 6f 73 65 0a 09 28 (if verbose..(
03f0: 62 65 67 69 6e 0a 09 20 20 28 64 69 73 70 6c 61 begin.. (displa
0400: 79 20 22 3b 3b 3b 20 52 65 73 75 6c 74 73 3a 20 y ";;; Results:
0410: 52 75 6e 73 3a 20 22 29 0a 09 20 20 28 64 69 73 Runs: ").. (dis
0420: 70 6c 61 79 20 72 75 6e 73 29 0a 09 20 20 28 64 play runs).. (d
0430: 69 73 70 6c 61 79 20 22 3b 20 47 6f 6f 64 73 3a isplay "; Goods:
0440: 20 22 29 0a 09 20 20 28 64 69 73 70 6c 61 79 20 ").. (display
0450: 67 6f 6f 64 73 29 0a 09 20 20 28 64 69 73 70 6c goods).. (displ
0460: 61 79 20 22 3b 20 42 61 64 73 3a 20 22 29 0a 09 ay "; Bads: ")..
0470: 20 20 28 64 69 73 70 6c 61 79 20 62 61 64 73 29 (display bads)
0480: 0a 09 20 20 28 69 66 20 28 3e 20 72 75 6e 73 20 .. (if (> runs
0490: 30 29 0a 09 20 20 20 20 20 20 28 62 65 67 69 6e 0).. (begin
04a0: 0a 09 09 28 64 69 73 70 6c 61 79 20 22 3b 20 50 ...(display "; P
04b0: 61 73 73 20 72 61 74 65 3a 20 22 29 0a 09 09 28 ass rate: ")...(
04c0: 64 69 73 70 6c 61 79 20 28 2f 20 67 6f 6f 64 73 display (/ goods
04d0: 20 72 75 6e 73 29 29 29 0a 09 20 20 20 20 20 20 runs)))..
04e0: 28 64 69 73 70 6c 61 79 20 22 3b 20 4e 6f 20 74 (display "; No t
04f0: 65 73 74 73 2e 22 29 29 0a 09 20 20 28 6e 65 77 ests.")).. (new
0500: 6c 69 6e 65 29 29 29 0a 20 20 20 20 28 76 61 6c line))). (val
0510: 75 65 73 20 72 75 6e 73 20 67 6f 6f 64 73 20 62 ues runs goods b
0520: 61 64 73 29 29 29 0a 0a 28 73 65 74 21 20 73 31 ads)))..(set! s1
0530: 39 2d 74 65 73 74 73 20 28 6c 69 73 74 29 29 0a 9-tests (list)).
0540: 0a 28 64 65 66 69 6e 65 2d 73 31 39 2d 74 65 73 .(define-s19-tes
0550: 74 21 20 22 43 72 65 61 74 69 6e 67 20 74 69 6d t! "Creating tim
0560: 65 20 73 74 72 75 63 74 75 72 65 73 22 0a 20 20 e structures".
0570: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 28 (lambda (). (
0580: 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 6c 69 73 74 not (null? (list
0590: 20 28 63 75 72 72 65 6e 74 2d 74 69 6d 65 20 27 (current-time '
05a0: 74 69 6d 65 2d 74 61 69 29 0a 09 09 20 20 20 20 time-tai)...
05b0: 20 20 28 63 75 72 72 65 6e 74 2d 74 69 6d 65 20 (current-time
05c0: 27 74 69 6d 65 2d 75 74 63 29 0a 09 09 20 20 20 'time-utc)...
05d0: 20 20 20 28 63 75 72 72 65 6e 74 2d 74 69 6d 65 (current-time
05e0: 20 27 74 69 6d 65 2d 6d 6f 6e 6f 74 6f 6e 69 63 'time-monotonic
05f0: 29 0a 09 09 20 20 20 20 20 20 23 7c 28 63 75 72 )... #|(cur
0600: 72 65 6e 74 2d 74 69 6d 65 20 27 74 69 6d 65 2d rent-time 'time-
0610: 74 68 72 65 61 64 29 0a 09 09 20 20 20 20 20 20 thread)...
0620: 28 63 75 72 72 65 6e 74 2d 74 69 6d 65 20 27 74 (current-time 't
0630: 69 6d 65 2d 70 72 6f 63 65 73 73 29 7c 23 29 29 ime-process)|#))
0640: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 31 39 )))..(define-s19
0650: 2d 74 65 73 74 21 20 22 54 65 73 74 69 6e 67 20 -test! "Testing
0660: 74 69 6d 65 20 72 65 73 6f 6c 75 74 69 6f 6e 73 time resolutions
0670: 22 0a 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 ". (lambda ().
0680: 20 20 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 28 (not (null? (
0690: 6c 69 73 74 20 28 74 69 6d 65 2d 72 65 73 6f 6c list (time-resol
06a0: 75 74 69 6f 6e 20 27 74 69 6d 65 2d 74 61 69 29 ution 'time-tai)
06b0: 0a 09 09 20 20 20 20 20 20 28 74 69 6d 65 2d 72 ... (time-r
06c0: 65 73 6f 6c 75 74 69 6f 6e 20 27 74 69 6d 65 2d esolution 'time-
06d0: 75 74 63 29 0a 09 09 20 20 20 20 20 20 28 74 69 utc)... (ti
06e0: 6d 65 2d 72 65 73 6f 6c 75 74 69 6f 6e 20 27 74 me-resolution 't
06f0: 69 6d 65 2d 6d 6f 6e 6f 74 6f 6e 69 63 29 0a 09 ime-monotonic)..
0700: 09 20 20 20 20 20 20 23 7c 28 74 69 6d 65 2d 72 . #|(time-r
0710: 65 73 6f 6c 75 74 69 6f 6e 20 27 74 69 6d 65 2d esolution 'time-
0720: 74 68 72 65 61 64 29 0a 09 09 20 20 20 20 20 20 thread)...
0730: 28 74 69 6d 65 2d 72 65 73 6f 6c 75 74 69 6f 6e (time-resolution
0740: 20 27 74 69 6d 65 2d 70 72 6f 63 65 73 73 29 7c 'time-process)|
0750: 23 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d #)))))..(define-
0760: 73 31 39 2d 74 65 73 74 21 20 22 54 69 6d 65 20 s19-test! "Time
0770: 63 6f 6d 70 61 72 69 73 6f 6e 73 20 28 74 69 6d comparisons (tim
0780: 65 3d 3f 2c 20 65 74 63 2e 29 22 0a 20 20 28 6c e=?, etc.)". (l
0790: 61 6d 62 64 61 20 28 29 0a 20 20 20 20 28 6c 65 ambda (). (le
07a0: 74 20 28 28 74 31 20 28 6d 61 6b 65 2d 74 69 6d t ((t1 (make-tim
07b0: 65 20 27 74 69 6d 65 2d 75 74 63 20 30 20 31 29 e 'time-utc 0 1)
07c0: 29 0a 09 20 20 28 74 32 20 28 6d 61 6b 65 2d 74 ).. (t2 (make-t
07d0: 69 6d 65 20 27 74 69 6d 65 2d 75 74 63 20 30 20 ime 'time-utc 0
07e0: 31 29 29 0a 09 20 20 28 74 33 20 28 6d 61 6b 65 1)).. (t3 (make
07f0: 2d 74 69 6d 65 20 27 74 69 6d 65 2d 75 74 63 20 -time 'time-utc
0800: 30 20 32 29 29 0a 09 20 20 28 74 31 31 20 28 6d 0 2)).. (t11 (m
0810: 61 6b 65 2d 74 69 6d 65 20 27 74 69 6d 65 2d 75 ake-time 'time-u
0820: 74 63 20 31 30 30 31 20 31 29 29 0a 09 20 20 28 tc 1001 1)).. (
0830: 74 31 32 20 28 6d 61 6b 65 2d 74 69 6d 65 20 27 t12 (make-time '
0840: 74 69 6d 65 2d 75 74 63 20 31 30 30 31 20 31 29 time-utc 1001 1)
0850: 29 0a 09 20 20 28 74 31 33 20 28 6d 61 6b 65 2d ).. (t13 (make-
0860: 74 69 6d 65 20 27 74 69 6d 65 2d 75 74 63 20 31 time 'time-utc 1
0870: 30 30 31 20 32 29 29 0a 09 20 20 29 0a 20 20 20 001 2)).. ).
0880: 20 20 20 28 61 6e 64 20 28 74 69 6d 65 3d 3f 20 (and (time=?
0890: 74 31 20 74 32 29 0a 09 20 20 20 28 74 69 6d 65 t1 t2).. (time
08a0: 3e 3f 20 74 33 20 74 32 29 0a 09 20 20 20 28 74 >? t3 t2).. (t
08b0: 69 6d 65 3c 3f 20 74 32 20 74 33 29 0a 09 20 20 ime<? t2 t3)..
08c0: 20 28 74 69 6d 65 3e 3d 3f 20 74 31 20 74 32 29 (time>=? t1 t2)
08d0: 0a 09 20 20 20 28 74 69 6d 65 3e 3d 3f 20 74 33 .. (time>=? t3
08e0: 20 74 32 29 0a 09 20 20 20 28 74 69 6d 65 3c 3d t2).. (time<=
08f0: 3f 20 74 31 20 74 32 29 0a 09 20 20 20 28 74 69 ? t1 t2).. (ti
0900: 6d 65 3c 3d 3f 20 74 32 20 74 33 29 0a 09 20 20 me<=? t2 t3)..
0910: 20 28 74 69 6d 65 3d 3f 20 74 31 31 20 74 31 32 (time=? t11 t12
0920: 29 0a 09 20 20 20 28 74 69 6d 65 3e 3f 20 74 31 ).. (time>? t1
0930: 33 20 74 31 32 29 0a 09 20 20 20 28 74 69 6d 65 3 t12).. (time
0940: 3c 3f 20 74 31 32 20 74 31 33 29 0a 09 20 20 20 <? t12 t13)..
0950: 28 74 69 6d 65 3e 3d 3f 20 74 31 31 20 74 31 32 (time>=? t11 t12
0960: 29 0a 09 20 20 20 28 74 69 6d 65 3e 3d 3f 20 74 ).. (time>=? t
0970: 31 33 20 74 31 32 29 0a 09 20 20 20 28 74 69 6d 13 t12).. (tim
0980: 65 3c 3d 3f 20 74 31 31 20 74 31 32 29 0a 09 20 e<=? t11 t12)..
0990: 20 20 28 74 69 6d 65 3c 3d 3f 20 74 31 32 20 74 (time<=? t12 t
09a0: 31 33 29 0a 09 20 20 20 29 29 29 29 0a 0a 28 64 13).. ))))..(d
09b0: 65 66 69 6e 65 2d 73 31 39 2d 74 65 73 74 21 20 efine-s19-test!
09c0: 22 54 69 6d 65 20 64 69 66 66 65 72 65 6e 63 65 "Time difference
09d0: 22 0a 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 ". (lambda ().
09e0: 20 20 20 28 6c 65 74 20 28 28 74 31 20 28 6d 61 (let ((t1 (ma
09f0: 6b 65 2d 74 69 6d 65 20 27 74 69 6d 65 2d 75 74 ke-time 'time-ut
0a00: 63 20 30 20 33 30 30 30 29 29 0a 09 20 20 28 74 c 0 3000)).. (t
0a10: 32 20 28 6d 61 6b 65 2d 74 69 6d 65 20 27 74 69 2 (make-time 'ti
0a20: 6d 65 2d 75 74 63 20 30 20 31 30 30 30 29 29 0a me-utc 0 1000)).
0a30: 09 20 20 28 74 33 20 28 6d 61 6b 65 2d 74 69 6d . (t3 (make-tim
0a40: 65 20 27 74 69 6d 65 2d 64 75 72 61 74 69 6f 6e e 'time-duration
0a50: 20 30 20 32 30 30 30 29 29 0a 09 20 20 28 74 34 0 2000)).. (t4
0a60: 20 28 6d 61 6b 65 2d 74 69 6d 65 20 27 74 69 6d (make-time 'tim
0a70: 65 2d 64 75 72 61 74 69 6f 6e 20 30 20 2d 32 30 e-duration 0 -20
0a80: 30 30 29 29 29 0a 20 20 20 20 20 20 28 61 6e 64 00))). (and
0a90: 0a 20 20 20 20 20 20 20 28 74 69 6d 65 3d 3f 20 . (time=?
0aa0: 74 33 20 28 74 69 6d 65 2d 64 69 66 66 65 72 65 t3 (time-differe
0ab0: 6e 63 65 20 74 31 20 74 32 29 29 0a 20 20 20 20 nce t1 t2)).
0ac0: 20 20 20 28 74 69 6d 65 3d 3f 20 74 34 20 28 74 (time=? t4 (t
0ad0: 69 6d 65 2d 64 69 66 66 65 72 65 6e 63 65 20 74 ime-difference t
0ae0: 32 20 74 31 29 29 29 29 29 29 0a 0a 0a 28 64 65 2 t1))))))...(de
0af0: 66 69 6e 65 2d 73 31 39 2d 74 65 73 74 21 20 22 fine-s19-test! "
0b00: 54 69 6d 65 20 64 69 66 66 65 72 65 6e 63 65 2c Time difference,
0b10: 20 6e 61 6e 6f 73 65 63 6f 6e 64 73 22 0a 20 20 nanoseconds".
0b20: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 28 (lambda (). (
0b30: 6c 65 74 20 28 28 74 31 20 28 6d 61 6b 65 2d 74 let ((t1 (make-t
0b40: 69 6d 65 20 74 69 6d 65 2d 75 74 63 20 31 30 30 ime time-utc 100
0b50: 30 20 33 30 30 30 29 29 0a 20 20 20 20 20 20 20 0 3000)).
0b60: 20 20 20 28 74 32 20 28 6d 61 6b 65 2d 74 69 6d (t2 (make-tim
0b70: 65 20 74 69 6d 65 2d 75 74 63 20 30 20 33 30 30 e time-utc 0 300
0b80: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 0)). (t
0b90: 33 20 28 6d 61 6b 65 2d 74 69 6d 65 20 74 69 6d 3 (make-time tim
0ba0: 65 2d 64 75 72 61 74 69 6f 6e 20 31 30 30 30 20 e-duration 1000
0bb0: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 74 0)). (t
0bc0: 34 20 28 6d 61 6b 65 2d 74 69 6d 65 20 74 69 6d 4 (make-time tim
0bd0: 65 2d 64 75 72 61 74 69 6f 6e 20 39 39 39 39 39 e-duration 99999
0be0: 39 30 30 30 20 2d 31 29 29 29 0a 20 20 20 20 20 9000 -1))).
0bf0: 20 28 61 6e 64 0a 20 20 20 20 20 20 20 20 28 74 (and. (t
0c00: 69 6d 65 3d 3f 20 74 33 20 28 74 69 6d 65 2d 64 ime=? t3 (time-d
0c10: 69 66 66 65 72 65 6e 63 65 20 74 31 20 74 32 29 ifference t1 t2)
0c20: 29 0a 20 20 20 20 20 20 20 20 28 74 69 6d 65 3d ). (time=
0c30: 3f 20 74 34 20 28 74 69 6d 65 2d 64 69 66 66 65 ? t4 (time-diffe
0c40: 72 65 6e 63 65 20 74 32 20 74 31 29 29 29 29 29 rence t2 t1)))))
0c50: 29 0a 0a 28 64 65 66 69 6e 65 20 28 74 65 73 74 )..(define (test
0c60: 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 -one-utc-tai-edg
0c70: 65 20 75 74 63 20 74 61 69 2d 64 69 66 66 20 74 e utc tai-diff t
0c80: 61 69 2d 6c 61 73 74 2d 64 69 66 66 29 0a 20 20 ai-last-diff).
0c90: 28 6c 65 74 2a 20 28 3b 3b 20 72 69 67 68 74 20 (let* (;; right
0ca0: 6f 6e 20 74 68 65 20 65 64 67 65 20 74 68 65 79 on the edge they
0cb0: 20 73 68 6f 75 6c 64 20 62 65 20 74 68 65 20 73 should be the s
0cc0: 61 6d 65 0a 09 20 28 75 74 63 2d 62 61 73 69 63 ame.. (utc-basic
0cd0: 20 28 6d 61 6b 65 2d 74 69 6d 65 20 27 74 69 6d (make-time 'tim
0ce0: 65 2d 75 74 63 20 30 20 75 74 63 29 29 0a 09 20 e-utc 0 utc))..
0cf0: 28 74 61 69 2d 62 61 73 69 63 20 28 6d 61 6b 65 (tai-basic (make
0d00: 2d 74 69 6d 65 20 27 74 69 6d 65 2d 74 61 69 20 -time 'time-tai
0d10: 30 20 28 2b 20 75 74 63 20 74 61 69 2d 64 69 66 0 (+ utc tai-dif
0d20: 66 29 29 29 0a 09 20 28 75 74 63 2d 3e 74 61 69 f))).. (utc->tai
0d30: 2d 62 61 73 69 63 20 28 74 69 6d 65 2d 75 74 63 -basic (time-utc
0d40: 2d 3e 74 69 6d 65 2d 74 61 69 20 75 74 63 2d 62 ->time-tai utc-b
0d50: 61 73 69 63 29 29 0a 09 20 28 74 61 69 2d 3e 75 asic)).. (tai->u
0d60: 74 63 2d 62 61 73 69 63 20 28 74 69 6d 65 2d 74 tc-basic (time-t
0d70: 61 69 2d 3e 74 69 6d 65 2d 75 74 63 20 74 61 69 ai->time-utc tai
0d80: 2d 62 61 73 69 63 29 29 0a 09 20 3b 3b 20 61 20 -basic)).. ;; a
0d90: 73 65 63 6f 6e 64 20 62 65 66 6f 72 65 20 74 68 second before th
0da0: 65 79 20 73 68 6f 75 6c 64 20 62 65 20 74 68 65 ey should be the
0db0: 20 6f 6c 64 20 64 69 66 66 0a 09 20 28 75 74 63 old diff.. (utc
0dc0: 2d 62 61 73 69 63 2d 31 20 28 6d 61 6b 65 2d 74 -basic-1 (make-t
0dd0: 69 6d 65 20 27 74 69 6d 65 2d 75 74 63 20 30 20 ime 'time-utc 0
0de0: 28 2d 20 75 74 63 20 31 29 29 29 0a 09 20 28 74 (- utc 1))).. (t
0df0: 61 69 2d 62 61 73 69 63 2d 31 20 28 6d 61 6b 65 ai-basic-1 (make
0e00: 2d 74 69 6d 65 20 27 74 69 6d 65 2d 74 61 69 20 -time 'time-tai
0e10: 30 20 28 2d 20 28 2b 20 75 74 63 20 74 61 69 2d 0 (- (+ utc tai-
0e20: 6c 61 73 74 2d 64 69 66 66 29 20 31 29 29 29 0a last-diff) 1))).
0e30: 09 20 28 75 74 63 2d 3e 74 61 69 2d 62 61 73 69 . (utc->tai-basi
0e40: 63 2d 31 20 28 74 69 6d 65 2d 75 74 63 2d 3e 74 c-1 (time-utc->t
0e50: 69 6d 65 2d 74 61 69 20 75 74 63 2d 62 61 73 69 ime-tai utc-basi
0e60: 63 2d 31 29 29 0a 09 20 28 74 61 69 2d 3e 75 74 c-1)).. (tai->ut
0e70: 63 2d 62 61 73 69 63 2d 31 20 28 74 69 6d 65 2d c-basic-1 (time-
0e80: 74 61 69 2d 3e 74 69 6d 65 2d 75 74 63 20 74 61 tai->time-utc ta
0e90: 69 2d 62 61 73 69 63 2d 31 29 29 0a 09 20 3b 3b i-basic-1)).. ;;
0ea0: 20 61 20 73 65 63 6f 6e 64 20 6c 61 74 65 72 20 a second later
0eb0: 74 68 65 79 20 73 68 6f 75 6c 64 20 62 65 20 74 they should be t
0ec0: 68 65 20 6e 65 77 20 64 69 66 66 0a 09 20 28 75 he new diff.. (u
0ed0: 74 63 2d 62 61 73 69 63 2b 31 20 28 6d 61 6b 65 tc-basic+1 (make
0ee0: 2d 74 69 6d 65 20 27 74 69 6d 65 2d 75 74 63 20 -time 'time-utc
0ef0: 30 20 28 2b 20 75 74 63 20 31 29 29 29 0a 09 20 0 (+ utc 1)))..
0f00: 28 74 61 69 2d 62 61 73 69 63 2b 31 20 28 6d 61 (tai-basic+1 (ma
0f10: 6b 65 2d 74 69 6d 65 20 27 74 69 6d 65 2d 74 61 ke-time 'time-ta
0f20: 69 20 30 20 28 2b 20 28 2b 20 75 74 63 20 74 61 i 0 (+ (+ utc ta
0f30: 69 2d 64 69 66 66 29 20 31 29 29 29 0a 09 20 28 i-diff) 1))).. (
0f40: 75 74 63 2d 3e 74 61 69 2d 62 61 73 69 63 2b 31 utc->tai-basic+1
0f50: 20 28 74 69 6d 65 2d 75 74 63 2d 3e 74 69 6d 65 (time-utc->time
0f60: 2d 74 61 69 20 75 74 63 2d 62 61 73 69 63 2b 31 -tai utc-basic+1
0f70: 29 29 0a 09 20 28 74 61 69 2d 3e 75 74 63 2d 62 )).. (tai->utc-b
0f80: 61 73 69 63 2b 31 20 28 74 69 6d 65 2d 74 61 69 asic+1 (time-tai
0f90: 2d 3e 74 69 6d 65 2d 75 74 63 20 74 61 69 2d 62 ->time-utc tai-b
0fa0: 61 73 69 63 2b 31 29 29 0a 09 20 3b 3b 20 6f 6b asic+1)).. ;; ok
0fb0: 2c 20 6c 65 74 27 73 20 6d 6f 76 65 20 74 68 65 , let's move the
0fc0: 20 63 6c 6f 63 6b 20 68 61 6c 66 20 61 20 6d 6f clock half a mo
0fd0: 6e 74 68 20 6f 72 20 73 6f 20 70 6c 75 73 20 68 nth or so plus h
0fe0: 61 6c 66 20 61 20 73 65 63 6f 6e 64 0a 09 20 28 alf a second.. (
0ff0: 73 68 79 20 28 2a 20 31 35 20 32 34 20 36 30 20 shy (* 15 24 60
1000: 36 30 29 29 0a 09 20 28 68 73 20 28 2f 20 28 65 60)).. (hs (/ (e
1010: 78 70 74 20 31 30 20 39 29 20 32 29 29 0a 09 20 xpt 10 9) 2))..
1020: 3b 3b 20 61 20 73 65 63 6f 6e 64 20 6c 61 74 65 ;; a second late
1030: 72 20 74 68 65 79 20 73 68 6f 75 6c 64 20 62 65 r they should be
1040: 20 74 68 65 20 6e 65 77 20 64 69 66 66 0a 09 20 the new diff..
1050: 28 75 74 63 2d 62 61 73 69 63 2b 32 20 28 6d 61 (utc-basic+2 (ma
1060: 6b 65 2d 74 69 6d 65 20 27 74 69 6d 65 2d 75 74 ke-time 'time-ut
1070: 63 20 68 73 20 28 2b 20 75 74 63 20 73 68 79 29 c hs (+ utc shy)
1080: 29 29 0a 09 20 28 74 61 69 2d 62 61 73 69 63 2b )).. (tai-basic+
1090: 32 20 28 6d 61 6b 65 2d 74 69 6d 65 20 27 74 69 2 (make-time 'ti
10a0: 6d 65 2d 74 61 69 20 68 73 20 28 2b 20 28 2b 20 me-tai hs (+ (+
10b0: 75 74 63 20 74 61 69 2d 64 69 66 66 29 20 73 68 utc tai-diff) sh
10c0: 79 29 29 29 0a 09 20 28 75 74 63 2d 3e 74 61 69 y))).. (utc->tai
10d0: 2d 62 61 73 69 63 2b 32 20 28 74 69 6d 65 2d 75 -basic+2 (time-u
10e0: 74 63 2d 3e 74 69 6d 65 2d 74 61 69 20 75 74 63 tc->time-tai utc
10f0: 2d 62 61 73 69 63 2b 32 29 29 0a 09 20 28 74 61 -basic+2)).. (ta
1100: 69 2d 3e 75 74 63 2d 62 61 73 69 63 2b 32 20 28 i->utc-basic+2 (
1110: 74 69 6d 65 2d 74 61 69 2d 3e 74 69 6d 65 2d 75 time-tai->time-u
1120: 74 63 20 74 61 69 2d 62 61 73 69 63 2b 32 29 29 tc tai-basic+2))
1130: 0a 09 20 29 0a 20 20 20 20 28 61 6e 64 20 28 74 .. ). (and (t
1140: 69 6d 65 3d 3f 20 75 74 63 2d 62 61 73 69 63 20 ime=? utc-basic
1150: 74 61 69 2d 3e 75 74 63 2d 62 61 73 69 63 29 0a tai->utc-basic).
1160: 09 20 28 74 69 6d 65 3d 3f 20 74 61 69 2d 62 61 . (time=? tai-ba
1170: 73 69 63 20 75 74 63 2d 3e 74 61 69 2d 62 61 73 sic utc->tai-bas
1180: 69 63 29 0a 09 20 28 74 69 6d 65 3d 3f 20 75 74 ic).. (time=? ut
1190: 63 2d 62 61 73 69 63 2d 31 20 74 61 69 2d 3e 75 c-basic-1 tai->u
11a0: 74 63 2d 62 61 73 69 63 2d 31 29 0a 09 20 28 74 tc-basic-1).. (t
11b0: 69 6d 65 3d 3f 20 74 61 69 2d 62 61 73 69 63 2d ime=? tai-basic-
11c0: 31 20 75 74 63 2d 3e 74 61 69 2d 62 61 73 69 63 1 utc->tai-basic
11d0: 2d 31 29 0a 09 20 28 74 69 6d 65 3d 3f 20 75 74 -1).. (time=? ut
11e0: 63 2d 62 61 73 69 63 2b 31 20 74 61 69 2d 3e 75 c-basic+1 tai->u
11f0: 74 63 2d 62 61 73 69 63 2b 31 29 0a 09 20 28 74 tc-basic+1).. (t
1200: 69 6d 65 3d 3f 20 74 61 69 2d 62 61 73 69 63 2b ime=? tai-basic+
1210: 31 20 75 74 63 2d 3e 74 61 69 2d 62 61 73 69 63 1 utc->tai-basic
1220: 2b 31 29 0a 09 20 28 74 69 6d 65 3d 3f 20 75 74 +1).. (time=? ut
1230: 63 2d 62 61 73 69 63 2b 32 20 74 61 69 2d 3e 75 c-basic+2 tai->u
1240: 74 63 2d 62 61 73 69 63 2b 32 29 0a 09 20 28 74 tc-basic+2).. (t
1250: 69 6d 65 3d 3f 20 74 61 69 2d 62 61 73 69 63 2b ime=? tai-basic+
1260: 32 20 75 74 63 2d 3e 74 61 69 2d 62 61 73 69 63 2 utc->tai-basic
1270: 2b 32 29 20 0a 09 20 29 29 29 0a 0a 28 64 65 66 +2) .. )))..(def
1280: 69 6e 65 2d 73 31 39 2d 74 65 73 74 21 20 22 54 ine-s19-test! "T
1290: 41 49 2d 55 54 43 20 43 6f 6e 76 65 72 73 69 6f AI-UTC Conversio
12a0: 6e 73 22 0a 20 20 28 6c 61 6d 62 64 61 20 28 29 ns". (lambda ()
12b0: 0a 20 20 20 20 28 61 6e 64 0a 20 20 20 20 20 28 . (and. (
12c0: 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 test-one-utc-tai
12d0: 2d 65 64 67 65 20 39 31 35 31 34 38 38 30 30 20 -edge 915148800
12e0: 20 33 32 20 33 31 29 0a 20 20 20 20 20 28 74 65 32 31). (te
12f0: 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 st-one-utc-tai-e
1300: 64 67 65 20 38 36 37 37 31 35 32 30 30 20 20 33 dge 867715200 3
1310: 31 20 33 30 29 0a 20 20 20 20 20 28 74 65 73 74 1 30). (test
1320: 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 -one-utc-tai-edg
1330: 65 20 38 32 30 34 35 34 34 30 30 20 20 33 30 20 e 820454400 30
1340: 32 39 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 29). (test-o
1350: 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 ne-utc-tai-edge
1360: 37 37 33 30 32 30 38 30 30 20 20 32 39 20 32 38 773020800 29 28
1370: 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 ). (test-one
1380: 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 37 34 -utc-tai-edge 74
1390: 31 34 38 34 38 30 30 20 20 32 38 20 32 37 29 0a 1484800 28 27).
13a0: 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 (test-one-u
13b0: 74 63 2d 74 61 69 2d 65 64 67 65 20 37 30 39 39 tc-tai-edge 7099
13c0: 34 38 38 30 30 20 20 32 37 20 32 36 29 0a 20 20 48800 27 26).
13d0: 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 (test-one-utc
13e0: 2d 74 61 69 2d 65 64 67 65 20 36 36 32 36 38 38 -tai-edge 662688
13f0: 30 30 30 20 20 32 36 20 32 35 29 0a 20 20 20 20 000 26 25).
1400: 20 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 (test-one-utc-t
1410: 61 69 2d 65 64 67 65 20 36 33 31 31 35 32 30 30 ai-edge 63115200
1420: 30 20 20 32 35 20 32 34 29 0a 20 20 20 20 20 28 0 25 24). (
1430: 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 test-one-utc-tai
1440: 2d 65 64 67 65 20 35 36 37 39 39 33 36 30 30 20 -edge 567993600
1450: 20 32 34 20 32 33 29 0a 20 20 20 20 20 28 74 65 24 23). (te
1460: 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 st-one-utc-tai-e
1470: 64 67 65 20 34 38 39 30 32 34 30 30 30 20 20 32 dge 489024000 2
1480: 33 20 32 32 29 0a 20 20 20 20 20 28 74 65 73 74 3 22). (test
1490: 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 -one-utc-tai-edg
14a0: 65 20 34 32 35 38 36 35 36 30 30 20 20 32 32 20 e 425865600 22
14b0: 32 31 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 21). (test-o
14c0: 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 ne-utc-tai-edge
14d0: 33 39 34 33 32 39 36 30 30 20 20 32 31 20 32 30 394329600 21 20
14e0: 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 ). (test-one
14f0: 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 33 36 -utc-tai-edge 36
1500: 32 37 39 33 36 30 30 20 20 32 30 20 31 39 29 0a 2793600 20 19).
1510: 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 (test-one-u
1520: 74 63 2d 74 61 69 2d 65 64 67 65 20 33 31 35 35 tc-tai-edge 3155
1530: 33 32 38 30 30 20 20 31 39 20 31 38 29 0a 20 20 32800 19 18).
1540: 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 (test-one-utc
1550: 2d 74 61 69 2d 65 64 67 65 20 32 38 33 39 39 36 -tai-edge 283996
1560: 38 30 30 20 20 31 38 20 31 37 29 0a 20 20 20 20 800 18 17).
1570: 20 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 (test-one-utc-t
1580: 61 69 2d 65 64 67 65 20 32 35 32 34 36 30 38 30 ai-edge 25246080
1590: 30 20 20 31 37 20 31 36 29 0a 20 20 20 20 20 28 0 17 16). (
15a0: 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 test-one-utc-tai
15b0: 2d 65 64 67 65 20 32 32 30 39 32 34 38 30 30 20 -edge 220924800
15c0: 20 31 36 20 31 35 29 0a 20 20 20 20 20 28 74 65 16 15). (te
15d0: 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 st-one-utc-tai-e
15e0: 64 67 65 20 31 38 39 33 30 32 34 30 30 20 20 31 dge 189302400 1
15f0: 35 20 31 34 29 0a 20 20 20 20 20 28 74 65 73 74 5 14). (test
1600: 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 -one-utc-tai-edg
1610: 65 20 31 35 37 37 36 36 34 30 30 20 20 31 34 20 e 157766400 14
1620: 31 33 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 13). (test-o
1630: 6e 65 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 ne-utc-tai-edge
1640: 31 32 36 32 33 30 34 30 30 20 20 31 33 20 31 32 126230400 13 12
1650: 29 0a 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 ). (test-one
1660: 2d 75 74 63 2d 74 61 69 2d 65 64 67 65 20 39 34 -utc-tai-edge 94
1670: 36 39 34 34 30 30 20 20 20 31 32 20 31 31 29 0a 694400 12 11).
1680: 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 (test-one-u
1690: 74 63 2d 74 61 69 2d 65 64 67 65 20 37 38 37 39 tc-tai-edge 7879
16a0: 36 38 30 30 20 20 20 31 31 20 31 30 29 0a 20 20 6800 11 10).
16b0: 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 (test-one-utc
16c0: 2d 74 61 69 2d 65 64 67 65 20 36 33 30 37 32 30 -tai-edge 630720
16d0: 30 30 20 20 20 31 30 20 30 29 0a 20 20 20 20 20 00 10 0).
16e0: 28 74 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 (test-one-utc-ta
16f0: 69 2d 65 64 67 65 20 30 20 20 20 30 20 30 29 20 i-edge 0 0 0)
1700: 3b 3b 20 61 74 20 74 68 65 20 65 70 6f 63 68 0a ;; at the epoch.
1710: 20 20 20 20 20 28 74 65 73 74 2d 6f 6e 65 2d 75 (test-one-u
1720: 74 63 2d 74 61 69 2d 65 64 67 65 20 31 30 20 20 tc-tai-edge 10
1730: 20 30 20 30 29 20 3b 3b 20 63 6c 6f 73 65 20 74 0 0) ;; close t
1740: 6f 20 69 74 20 2e 2e 2e 0a 20 20 20 20 20 28 74 o it .... (t
1750: 65 73 74 2d 6f 6e 65 2d 75 74 63 2d 74 61 69 2d est-one-utc-tai-
1760: 65 64 67 65 20 31 30 34 35 37 38 39 36 34 35 20 edge 1045789645
1770: 33 32 20 33 32 29 20 3b 3b 20 61 62 6f 75 74 20 32 32) ;; about
1780: 6e 6f 77 20 2e 2e 2e 0a 20 20 20 20 20 29 29 29 now .... )))
1790: 0a 0a 28 64 65 66 69 6e 65 20 28 74 6d 3a 64 61 ..(define (tm:da
17a0: 74 65 3d 20 64 31 20 64 32 29 0a 20 20 28 61 6e te= d1 d2). (an
17b0: 64 20 28 3d 20 28 64 61 74 65 2d 79 65 61 72 20 d (= (date-year
17c0: 64 31 29 20 28 64 61 74 65 2d 79 65 61 72 20 64 d1) (date-year d
17d0: 32 29 29 0a 20 20 20 20 20 20 20 28 3d 20 28 64 2)). (= (d
17e0: 61 74 65 2d 6d 6f 6e 74 68 20 64 31 29 20 28 64 ate-month d1) (d
17f0: 61 74 65 2d 6d 6f 6e 74 68 20 64 32 29 29 0a 20 ate-month d2)).
1800: 20 20 20 20 20 20 28 3d 20 28 64 61 74 65 2d 64 (= (date-d
1810: 61 79 20 64 31 29 20 28 64 61 74 65 2d 64 61 79 ay d1) (date-day
1820: 20 64 32 29 29 0a 20 20 20 20 20 20 20 28 3d 20 d2)). (=
1830: 28 64 61 74 65 2d 68 6f 75 72 20 64 31 29 20 28 (date-hour d1) (
1840: 64 61 74 65 2d 68 6f 75 72 20 64 32 29 29 0a 20 date-hour d2)).
1850: 20 20 20 20 20 20 28 3d 20 28 64 61 74 65 2d 73 (= (date-s
1860: 65 63 6f 6e 64 20 64 31 29 20 28 64 61 74 65 2d econd d1) (date-
1870: 73 65 63 6f 6e 64 20 64 32 29 29 0a 20 20 20 20 second d2)).
1880: 20 20 20 28 3d 20 28 64 61 74 65 2d 6e 61 6e 6f (= (date-nano
1890: 73 65 63 6f 6e 64 20 64 31 29 20 28 64 61 74 65 second d1) (date
18a0: 2d 6e 61 6e 6f 73 65 63 6f 6e 64 20 64 32 29 29 -nanosecond d2))
18b0: 0a 20 20 20 20 20 20 20 28 3d 20 28 64 61 74 65 . (= (date
18c0: 2d 7a 6f 6e 65 2d 6f 66 66 73 65 74 20 64 31 29 -zone-offset d1)
18d0: 20 28 64 61 74 65 2d 7a 6f 6e 65 2d 6f 66 66 73 (date-zone-offs
18e0: 65 74 20 64 32 29 29 29 29 0a 0a 28 64 65 66 69 et d2))))..(defi
18f0: 6e 65 2d 73 31 39 2d 74 65 73 74 21 20 22 54 41 ne-s19-test! "TA
1900: 49 2d 44 61 74 65 20 43 6f 6e 76 65 72 73 69 6f I-Date Conversio
1910: 6e 73 22 0a 20 20 28 6c 61 6d 62 64 61 20 28 29 ns". (lambda ()
1920: 0a 20 20 20 20 28 61 6e 64 0a 20 20 20 20 20 28 . (and. (
1930: 74 6d 3a 64 61 74 65 3d 20 28 74 69 6d 65 2d 74 tm:date= (time-t
1940: 61 69 2d 3e 64 61 74 65 20 28 6d 61 6b 65 2d 74 ai->date (make-t
1950: 69 6d 65 20 74 69 6d 65 2d 74 61 69 20 30 20 28 ime time-tai 0 (
1960: 2b 20 39 31 35 31 34 38 38 30 30 20 32 39 29 29 + 915148800 29))
1970: 20 30 29 0a 09 20 20 20 20 20 20 20 28 6d 61 6b 0).. (mak
1980: 65 2d 64 61 74 65 20 30 20 35 38 20 35 39 20 32 e-date 0 58 59 2
1990: 33 20 33 31 20 31 32 20 31 39 39 38 20 30 29 29 3 31 12 1998 0))
19a0: 0a 20 20 20 20 20 28 74 6d 3a 64 61 74 65 3d 20 . (tm:date=
19b0: 28 74 69 6d 65 2d 74 61 69 2d 3e 64 61 74 65 20 (time-tai->date
19c0: 28 6d 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 2d (make-time time-
19d0: 74 61 69 20 30 20 28 2b 20 39 31 35 31 34 38 38 tai 0 (+ 9151488
19e0: 30 30 20 33 30 29 29 20 30 29 0a 09 20 20 20 20 00 30)) 0)..
19f0: 20 20 20 28 6d 61 6b 65 2d 64 61 74 65 20 30 20 (make-date 0
1a00: 35 39 20 35 39 20 32 33 20 33 31 20 31 32 20 31 59 59 23 31 12 1
1a10: 39 39 38 20 30 29 29 0a 20 20 20 20 20 28 74 6d 998 0)). (tm
1a20: 3a 64 61 74 65 3d 20 28 74 69 6d 65 2d 74 61 69 :date= (time-tai
1a30: 2d 3e 64 61 74 65 20 28 6d 61 6b 65 2d 74 69 6d ->date (make-tim
1a40: 65 20 74 69 6d 65 2d 74 61 69 20 30 20 28 2b 20 e time-tai 0 (+
1a50: 39 31 35 31 34 38 38 30 30 20 33 31 29 29 20 30 915148800 31)) 0
1a60: 29 0a 09 20 20 20 20 20 20 20 28 6d 61 6b 65 2d ).. (make-
1a70: 64 61 74 65 20 30 20 36 30 20 35 39 20 32 33 20 date 0 60 59 23
1a80: 33 31 20 31 32 20 31 39 39 38 20 30 29 29 0a 20 31 12 1998 0)).
1a90: 20 20 20 20 28 74 6d 3a 64 61 74 65 3d 20 28 74 (tm:date= (t
1aa0: 69 6d 65 2d 74 61 69 2d 3e 64 61 74 65 20 28 6d ime-tai->date (m
1ab0: 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 2d 74 61 ake-time time-ta
1ac0: 69 20 30 20 28 2b 20 39 31 35 31 34 38 38 30 30 i 0 (+ 915148800
1ad0: 20 33 32 29 29 20 30 29 0a 09 20 20 20 20 20 20 32)) 0)..
1ae0: 20 28 6d 61 6b 65 2d 64 61 74 65 20 30 20 30 20 (make-date 0 0
1af0: 30 20 30 20 31 20 31 20 31 39 39 39 20 30 29 29 0 0 1 1 1999 0))
1b00: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 31 39 )))..(define-s19
1b10: 2d 74 65 73 74 21 20 22 44 61 74 65 2d 55 54 43 -test! "Date-UTC
1b20: 20 43 6f 6e 76 65 72 73 69 6f 6e 73 22 0a 20 20 Conversions".
1b30: 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 28 (lambda (). (
1b40: 61 6e 64 0a 20 20 20 20 20 28 74 69 6d 65 3d 3f and. (time=?
1b50: 20 28 6d 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 (make-time time
1b60: 2d 75 74 63 20 30 20 28 2d 20 39 31 35 31 34 38 -utc 0 (- 915148
1b70: 38 30 30 20 32 29 29 0a 09 20 20 20 20 20 28 64 800 2)).. (d
1b80: 61 74 65 2d 3e 74 69 6d 65 2d 75 74 63 20 28 6d ate->time-utc (m
1b90: 61 6b 65 2d 64 61 74 65 20 30 20 35 38 20 35 39 ake-date 0 58 59
1ba0: 20 32 33 20 33 31 20 31 32 20 31 39 39 38 20 30 23 31 12 1998 0
1bb0: 29 29 29 0a 20 20 20 20 20 28 74 69 6d 65 3d 3f ))). (time=?
1bc0: 20 28 6d 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 (make-time time
1bd0: 2d 75 74 63 20 30 20 28 2d 20 39 31 35 31 34 38 -utc 0 (- 915148
1be0: 38 30 30 20 31 29 29 0a 09 20 20 20 20 20 28 64 800 1)).. (d
1bf0: 61 74 65 2d 3e 74 69 6d 65 2d 75 74 63 20 28 6d ate->time-utc (m
1c00: 61 6b 65 2d 64 61 74 65 20 30 20 35 39 20 35 39 ake-date 0 59 59
1c10: 20 32 33 20 33 31 20 31 32 20 31 39 39 38 20 30 23 31 12 1998 0
1c20: 29 29 29 0a 20 20 20 20 20 3b 3b 20 79 65 73 2c ))). ;; yes,
1c30: 20 49 20 74 68 69 6e 6b 20 74 68 69 73 20 69 73 I think this is
1c40: 20 61 63 75 74 61 6c 6c 79 20 72 69 67 68 74 2e acutally right.
1c50: 0a 20 20 20 20 20 28 74 69 6d 65 3d 3f 20 28 6d . (time=? (m
1c60: 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 2d 75 74 ake-time time-ut
1c70: 63 20 30 20 28 2d 20 39 31 35 31 34 38 38 30 30 c 0 (- 915148800
1c80: 20 30 29 29 0a 09 20 20 20 20 20 28 64 61 74 65 0)).. (date
1c90: 2d 3e 74 69 6d 65 2d 75 74 63 20 28 6d 61 6b 65 ->time-utc (make
1ca0: 2d 64 61 74 65 20 30 20 36 30 20 35 39 20 32 33 -date 0 60 59 23
1cb0: 20 33 31 20 31 32 20 31 39 39 38 20 30 29 29 29 31 12 1998 0)))
1cc0: 0a 20 20 20 20 20 28 74 69 6d 65 3d 3f 20 28 6d . (time=? (m
1cd0: 61 6b 65 2d 74 69 6d 65 20 74 69 6d 65 2d 75 74 ake-time time-ut
1ce0: 63 20 30 20 28 2d 20 39 31 35 31 34 38 38 30 30 c 0 (- 915148800
1cf0: 20 30 29 29 0a 09 20 20 20 20 20 28 64 61 74 65 0)).. (date
1d00: 2d 3e 74 69 6d 65 2d 75 74 63 20 28 6d 61 6b 65 ->time-utc (make
1d10: 2d 64 61 74 65 20 30 20 30 20 30 20 30 20 31 20 -date 0 0 0 0 1
1d20: 31 20 31 39 39 39 20 30 29 29 29 0a 20 20 20 20 1 1999 0))).
1d30: 20 28 74 69 6d 65 3d 3f 20 28 6d 61 6b 65 2d 74 (time=? (make-t
1d40: 69 6d 65 20 74 69 6d 65 2d 75 74 63 20 30 20 28 ime time-utc 0 (
1d50: 2b 20 39 31 35 31 34 38 38 30 30 20 31 29 29 0a + 915148800 1)).
1d60: 09 20 20 20 20 20 28 64 61 74 65 2d 3e 74 69 6d . (date->tim
1d70: 65 2d 75 74 63 20 28 6d 61 6b 65 2d 64 61 74 65 e-utc (make-date
1d80: 20 30 20 31 20 30 20 30 20 31 20 31 20 31 39 39 0 1 0 0 1 1 199
1d90: 39 20 30 29 29 29 29 29 29 0a 0a 28 64 65 66 69 9 0))))))..(defi
1da0: 6e 65 2d 73 31 39 2d 74 65 73 74 21 20 22 54 5a ne-s19-test! "TZ
1db0: 20 4f 66 66 73 65 74 20 63 6f 6e 76 65 72 73 69 Offset conversi
1dc0: 6f 6e 73 22 0a 20 20 28 6c 61 6d 62 64 61 20 28 ons". (lambda (
1dd0: 29 0a 20 20 20 20 28 6c 65 74 20 28 28 63 74 2d ). (let ((ct-
1de0: 75 74 63 20 28 6d 61 6b 65 2d 74 69 6d 65 20 74 utc (make-time t
1df0: 69 6d 65 2d 75 74 63 20 36 33 32 30 30 30 30 20 ime-utc 6320000
1e00: 31 30 34 35 39 34 34 38 35 39 29 29 0a 09 20 20 1045944859))..
1e10: 28 63 74 2d 74 61 69 20 28 6d 61 6b 65 2d 74 69 (ct-tai (make-ti
1e20: 6d 65 20 74 69 6d 65 2d 74 61 69 20 36 33 32 30 me time-tai 6320
1e30: 30 30 30 20 31 30 34 35 39 34 34 38 39 31 29 29 000 1045944891))
1e40: 0a 09 20 20 28 63 64 20 28 6d 61 6b 65 2d 64 61 .. (cd (make-da
1e50: 74 65 20 36 33 32 30 30 30 30 20 31 39 20 31 34 te 6320000 19 14
1e60: 20 31 35 20 32 32 20 32 20 32 30 30 33 20 2d 31 15 22 2 2003 -1
1e70: 38 30 30 30 29 29 29 0a 20 20 20 20 20 20 28 61 8000))). (a
1e80: 6e 64 0a 20 20 20 20 20 20 20 28 74 69 6d 65 3d nd. (time=
1e90: 3f 20 63 74 2d 75 74 63 20 28 64 61 74 65 2d 3e ? ct-utc (date->
1ea0: 74 69 6d 65 2d 75 74 63 20 63 64 29 29 0a 20 20 time-utc cd)).
1eb0: 20 20 20 20 20 28 74 69 6d 65 3d 3f 20 63 74 2d (time=? ct-
1ec0: 74 61 69 20 28 64 61 74 65 2d 3e 74 69 6d 65 2d tai (date->time-
1ed0: 74 61 69 20 63 64 29 29 29 29 29 29 0a 0a 28 62 tai cd))))))..(b
1ee0: 65 67 69 6e 20 28 6e 65 77 6c 69 6e 65 29 20 28 egin (newline) (
1ef0: 72 75 6e 2d 73 31 39 2d 74 65 73 74 73 20 23 74 run-s19-tests #t
1f00: 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 64 61 ))...(define (da
1f10: 74 65 2d 3e 73 74 72 69 6e 67 2f 61 6c 6c 2d 66 te->string/all-f
1f20: 6f 72 6d 61 74 73 29 0a 20 20 3b 3b 20 54 4f 44 ormats). ;; TOD
1f30: 4f 3a 20 66 69 67 75 72 65 20 6f 75 74 20 77 68 O: figure out wh
1f40: 79 20 7e 66 20 69 73 6e 27 74 20 77 6f 72 6b 69 y ~f isn't worki
1f50: 6e 67 0a 20 20 3b 3b 20 54 4f 44 4f 3a 20 66 69 ng. ;; TODO: fi
1f60: 67 75 72 65 20 6f 75 74 20 77 68 79 20 7e 78 20 gure out why ~x
1f70: 61 6e 64 20 7e 58 20 61 72 65 6e 27 74 20 64 6f and ~X aren't do
1f80: 69 6e 67 20 77 68 61 74 20 74 68 65 20 73 72 66 ing what the srf
1f90: 69 2d 31 39 20 64 6f 63 20 73 61 79 73 20 74 68 i-19 doc says th
1fa0: 65 79 20 64 6f 0a 20 20 28 64 65 66 69 6e 65 20 ey do. (define
1fb0: 66 73 0a 20 20 20 20 27 28 22 7e 7e 22 20 22 7e fs. '("~~" "~
1fc0: 61 22 20 22 7e 41 22 20 22 7e 62 22 20 22 7e 42 a" "~A" "~b" "~B
1fd0: 22 20 22 7e 63 22 20 22 7e 64 22 20 22 7e 44 22 " "~c" "~d" "~D"
1fe0: 20 22 7e 65 22 20 23 3b 22 7e 66 22 20 22 7e 68 "~e" #;"~f" "~h
1ff0: 22 20 22 7e 48 22 0a 20 20 20 20 20 20 22 7e 49 " "~H". "~I
2000: 22 20 22 7e 6a 22 20 22 7e 6b 22 20 22 7e 6c 22 " "~j" "~k" "~l"
2010: 20 22 7e 6d 22 20 22 7e 4d 22 20 22 7e 6e 22 20 "~m" "~M" "~n"
2020: 22 7e 4e 22 20 22 7e 70 22 20 22 7e 72 22 20 22 "~N" "~p" "~r" "
2030: 7e 73 22 0a 20 20 20 20 20 20 22 7e 53 22 20 22 ~s". "~S" "
2040: 7e 74 22 20 22 7e 54 22 20 22 7e 55 22 20 22 7e ~t" "~T" "~U" "~
2050: 56 22 20 22 7e 77 22 20 22 7e 57 22 20 22 7e 78 V" "~w" "~W" "~x
2060: 22 20 22 7e 58 22 20 22 7e 79 22 20 22 7e 59 22 " "~X" "~y" "~Y"
2070: 0a 20 20 20 20 20 20 22 7e 7a 22 20 22 7e 5a 22 . "~z" "~Z"
2080: 20 22 7e 31 22 20 22 7e 32 22 20 22 7e 33 22 20 "~1" "~2" "~3"
2090: 22 7e 34 22 20 22 7e 35 22 29 29 0a 20 20 28 64 "~4" "~5")). (d
20a0: 65 66 69 6e 65 20 63 64 20 28 63 75 72 72 65 6e efine cd (curren
20b0: 74 2d 64 61 74 65 29 29 0a 20 20 28 64 69 73 70 t-date)). (disp
20c0: 6c 61 79 20 22 5c 6e 3b 3b 3b 20 52 75 6e 6e 69 lay "\n;;; Runni
20d0: 6e 67 20 64 61 74 65 2d 3e 73 74 72 69 6e 67 20 ng date->string
20e0: 66 6f 72 6d 61 74 20 65 78 65 72 63 69 73 65 5c format exercise\
20f0: 6e 22 29 0a 20 20 28 70 72 69 6e 74 66 20 22 28 n"). (printf "(
2100: 63 75 72 72 65 6e 74 2d 64 61 74 65 29 5c 6e 20 current-date)\n
2110: 3d 3e 20 7e 73 5c 6e 22 20 63 64 29 0a 20 20 28 => ~s\n" cd). (
2120: 66 6f 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d for-each. (lam
2130: 62 64 61 20 28 66 29 0a 20 20 20 20 20 28 70 72 bda (f). (pr
2140: 69 6e 74 66 20 22 5c 6e 2d 2d 2d 20 46 6f 72 6d intf "\n--- Form
2150: 61 74 3a 20 7e 61 20 2d 2d 2d 2d 2d 2d 2d 2d 2d at: ~a ---------
2160: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
2170: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 5c ---------------\
2180: 6e 22 20 66 29 20 0a 20 20 20 20 20 28 64 69 73 n" f) . (dis
2190: 70 6c 61 79 20 28 64 61 74 65 2d 3e 73 74 72 69 play (date->stri
21a0: 6e 67 20 63 64 20 66 29 29 20 28 6e 65 77 6c 69 ng cd f)) (newli
21b0: 6e 65 29 29 0a 20 20 20 66 73 29 29 0a 0a 3b 3b ne)). fs))..;;
21c0: 54 4f 44 4f 0a 23 3b 28 64 65 66 69 6e 65 20 28 TODO.#;(define (
21d0: 73 74 72 69 6e 67 2d 3e 64 61 74 65 2f 61 6c 6c string->date/all
21e0: 2d 66 6f 72 6d 61 74 73 29 0a 20 20 29 0a 0a 28 -formats). )..(
21f0: 64 61 74 65 2d 3e 73 74 72 69 6e 67 2f 61 6c 6c date->string/all
2200: 2d 66 6f 72 6d 61 74 73 29 0a 23 3b 28 73 74 72 -formats).#;(str
2210: 69 6e 67 2d 3e 64 61 74 65 2f 61 6c 6c 2d 66 6f ing->date/all-fo
2220: 72 6d 61 74 73 29 0a rmats).