;; These tests are translated from SRFI-19's tests into STklos' test
;; system.
;;
;; - The tests included a "tm:date=" predicate, but in STklos we can compare
;;   dates with equal?, so I deleted that part of the code.
;; - Removed the time-thread tests

(test "srfi-19 Creating time structures"
      #f
      (null? (list (current-time 'time-tai)
                   (current-time 'time-utc)
                   (current-time 'time-monotonic)
                   ;;(current-time 'time-thread)
                   (current-time 'time-process))))

(test "srfi-19 Testing time resolutions"
      #f (null? (list (time-resolution 'time-tai)
                      (time-resolution 'time-utc)
                      (time-resolution 'time-monotonic)
                      ;;(time-resolution 'time-thread)
                      (time-resolution 'time-process))))


(let ((t1 (make-time 'time-utc 0 1))
      (t2 (make-time 'time-utc 0 1))
      (t3 (make-time 'time-utc 0 2))
      (t11 (make-time 'time-utc 1001 1))
      (t12 (make-time 'time-utc 1001 1))
      (t13 (make-time 'time-utc 1001 2)))
  (test "srfi-19 Time comparisons (time=?, etc.)"
        #t
        (and (time=? t1 t2)
             (time>? t3 t2)
             (time<? t2 t3)
             (time>=? t1 t2)
             (time>=? t3 t2)
             (time<=? t1 t2)
             (time<=? t2 t3)
             (time=? t11 t12)
             (time>? t13 t12)
             (time<? t12 t13)
             (time>=? t11 t12)
             (time>=? t13 t12)
             (time<=? t11 t12)
             (time<=? t12 t13)
             )))

(let ((t1 (make-time 'time-utc 0 3000))
      (t2 (make-time 'time-utc 0 1000))
      (t3 (make-time 'time-duration 0 2000))
      (t4 (make-time 'time-duration 0 -2000)))
  (test "srfi-19 Time difference 1"
        #t
        (time=? t3 (time-difference t1 t2)))
  (test "srfi-19 Time difference 2"
        #t
        (time=? t4 (time-difference t2 t1))))

(define (test-one-utc-tai-edge utc tai-diff tai-last-diff)
  (let* (;; right on the edge they should be the same
         (utc-basic (make-time 'time-utc 0 utc))
         (tai-basic (make-time 'time-tai 0 (+ utc tai-diff)))
         (utc->tai-basic (time-utc->time-tai utc-basic))
         (tai->utc-basic (time-tai->time-utc tai-basic))
         ;; a second before they should be the old diff
         (utc-basic-1 (make-time 'time-utc 0 (- utc 1)))
         (tai-basic-1 (make-time 'time-tai 0 (- (+ utc tai-last-diff) 1)))
         (utc->tai-basic-1 (time-utc->time-tai utc-basic-1))
         (tai->utc-basic-1 (time-tai->time-utc tai-basic-1))
         ;; a second later they should be the new diff
         (utc-basic+1 (make-time 'time-utc 0 (+ utc 1)))
         (tai-basic+1 (make-time 'time-tai 0 (+ (+ utc tai-diff) 1)))
         (utc->tai-basic+1 (time-utc->time-tai utc-basic+1))
         (tai->utc-basic+1 (time-tai->time-utc tai-basic+1))
         ;; ok, let's move the clock half a month or so plus half a second
         (shy (* 15 24 60 60))
         (hs (/ (expt 10 9) 2))
         ;; a second later they should be the new diff
         (utc-basic+2 (make-time 'time-utc hs (+ utc shy)))
         (tai-basic+2 (make-time 'time-tai hs (+ (+ utc tai-diff) shy)))
         (utc->tai-basic+2 (time-utc->time-tai utc-basic+2))
         (tai->utc-basic+2 (time-tai->time-utc tai-basic+2)))
    (and (time=? utc-basic tai->utc-basic)
         (time=? tai-basic utc->tai-basic)
         (time=? utc-basic-1 tai->utc-basic-1)
         (time=? tai-basic-1 utc->tai-basic-1)
         (time=? utc-basic+1 tai->utc-basic+1)
         (time=? tai-basic+1 utc->tai-basic+1)
         (time=? utc-basic+2 tai->utc-basic+2)
         (time=? tai-basic+2 utc->tai-basic+2) )))

(test "srfi-19 TAI-UTC Conversions 1" #t      (test-one-utc-tai-edge 915148800  32 31))
(test "srfi-19 TAI-UTC Conversions 2" #t      (test-one-utc-tai-edge 867715200  31 30))
(test "srfi-19 TAI-UTC Conversions 3" #t      (test-one-utc-tai-edge 820454400  30 29))
(test "srfi-19 TAI-UTC Conversions 4" #t      (test-one-utc-tai-edge 773020800  29 28))
(test "srfi-19 TAI-UTC Conversions 5" #t      (test-one-utc-tai-edge 741484800  28 27))
(test "srfi-19 TAI-UTC Conversions 6" #t      (test-one-utc-tai-edge 709948800  27 26))
(test "srfi-19 TAI-UTC Conversions 7" #t      (test-one-utc-tai-edge 662688000  26 25))
(test "srfi-19 TAI-UTC Conversions 8" #t      (test-one-utc-tai-edge 631152000  25 24))
(test "srfi-19 TAI-UTC Conversions 9" #t      (test-one-utc-tai-edge 567993600  24 23))
(test "srfi-19 TAI-UTC Conversions 10" #t      (test-one-utc-tai-edge 489024000  23 22))
(test "srfi-19 TAI-UTC Conversions 11" #t      (test-one-utc-tai-edge 425865600  22 21))
(test "srfi-19 TAI-UTC Conversions 12" #t      (test-one-utc-tai-edge 394329600  21 20))
(test "srfi-19 TAI-UTC Conversions 13" #t      (test-one-utc-tai-edge 362793600  20 19))
(test "srfi-19 TAI-UTC Conversions 14" #t      (test-one-utc-tai-edge 315532800  19 18))
(test "srfi-19 TAI-UTC Conversions 15" #t      (test-one-utc-tai-edge 283996800  18 17))
(test "srfi-19 TAI-UTC Conversions 16" #t      (test-one-utc-tai-edge 252460800  17 16))
(test "srfi-19 TAI-UTC Conversions 17" #t      (test-one-utc-tai-edge 220924800  16 15))
(test "srfi-19 TAI-UTC Conversions 18" #t      (test-one-utc-tai-edge 189302400  15 14))
(test "srfi-19 TAI-UTC Conversions 19" #t      (test-one-utc-tai-edge 157766400  14 13))
(test "srfi-19 TAI-UTC Conversions 20" #t      (test-one-utc-tai-edge 126230400  13 12))
(test "srfi-19 TAI-UTC Conversions 21" #t      (test-one-utc-tai-edge 94694400   12 11))
(test "srfi-19 TAI-UTC Conversions 22" #t      (test-one-utc-tai-edge 78796800   11 10))
(test "srfi-19 TAI-UTC Conversions 23" #t      (test-one-utc-tai-edge 63072000   10 0))
(test "srfi-19 TAI-UTC Conversions 24" #t      (test-one-utc-tai-edge 0   0 0)) ;; at the epoch
(test "srfi-19 TAI-UTC Conversions 25" #t      (test-one-utc-tai-edge 10   0 0)) ;; close to it ...
(test "srfi-19 TAI-UTC Conversions 26" #t      (test-one-utc-tai-edge 1045789645 32 32)) ;; about now ...

;;
;; 915148800 => 1 Jan 1999
;;
(test "srfi-19 TAI-Date Conversions 1"
      #t
      (equal? (time-tai->date (make-time time-tai 0 (+ 915148800 29)) 0)
       (make-date 0 58 59 23 31 12 1998 0)))
(test "srfi-19 TAI-Date Conversions 2"
      #t
      (equal? (time-tai->date (make-time time-tai 0 (+ 915148800 30)) 0)
       (make-date 0 59 59 23 31 12 1998 0)))
(test "srfi-19 TAI-Date Conversions 3"
      #t
      (equal? (time-tai->date (make-time time-tai 0 (+ 915148800 31)) 0)
       (make-date 0 60 59 23 31 12 1998 0)))
(test "srfi-19 TAI-Date Conversions 4"
      #t
      (equal? (time-tai->date (make-time time-tai 0 (+ 915148800 32)) 0)
       (make-date 0 0 0 0 1 1 1999 0)))

(test "srfi-19 Date-UTC Conversions 1" #t (time=? (make-time time-utc 0 (- 915148800 2))
                                   (date->time-utc (make-date 0 58 59 23 31 12 1998 0))))
(test "srfi-19 Date-UTC Conversions 2" #t (time=? (make-time time-utc 0 (- 915148800 1))
                                   (date->time-utc (make-date 0 59 59 23 31 12 1998 0))))
     ;; yes, I think this is acutally right.
(test "srfi-19 Date-UTC Conversions 3" #t (time=? (make-time time-utc 0 (- 915148800 0))
                                   (date->time-utc (make-date 0 60 59 23 31 12 1998 0))))
(test "srfi-19 Date-UTC Conversions 4" #t (time=? (make-time time-utc 0 (- 915148800 0))
                                   (date->time-utc (make-date 0 0 0 0 1 1 1999 0))))
(test "srfi-19 Date-UTC Conversions 5" #t (time=? (make-time time-utc 0 (+ 915148800 1))
                                   (date->time-utc (make-date 0 1 0 0 1 1 1999 0))))

(let ((ct-utc (make-time time-utc 6320000 1045944859))
      (ct-tai (make-time time-tai 6320000 1045944891))
      (cd (make-date 6320000 19 14 15 22 2 2003 -18000)))
  (test "srfi 19 TZ Offset conversions 1" #t (time=? ct-utc (date->time-utc cd)))
  (test "srfi 19 TZ Offset conversions 2" #t (time=? ct-tai (date->time-tai cd))))

(let ((d (make-date 0 1 2 3 4 5 2006 0)))
  (test "srfi-19 date->string 1" " 3" (date->string d "~k"))
  (test "srfi-19 date->string 2" " 3" (date->string d "~l"))
  (test "srfi-19 date->string 3" "2006-05-04T03:02:01" (date->string d "~5"))
  (test "srfi-19 date->string 4" "2006-05-04T03:02:01Z" (date->string d "~4"))
  (test "srfi-19 date->string 5" "03:02:01" (date->string d "~3"))
  (test "srfi-19 date->string 6" "03:02:01Z" (date->string d "~2")))

(let ((dates '((2020 12 31 . "53") ; Thursday, week 53
               (2021 1 1   . "53") ; Friday, week 53 (previous year)
               (2021 1 3   . "53") ; Sunday, week 53 (previous year)
               (2021 1 4   . "01") ; Monday, week 1

               (2019 12 29 . "52") ; Sunday, week 52
               (2019 12 30 . "01") ; Monday, week 1 (next year)
               (2019 12 31 . "01") ; Tuesday, week 1 (next year)
               (2020 1 1   . "01") ; Wednesday, week 1

               (2016 12 31 . "52") ; Saturday, week 52
               (2017 1 1   . "52") ; Sunday, week 52 (previous year)
               (2017 1 2   . "01") ; Monday, week 1
               (2017 1 8   . "01") ; Sunday, week 1
               (2017 1 9   . "02") ; Monday, week 2

               (2014 12 28 . "52") ; Sunday, week 52
               (2014 12 29 . "01") ; Monday, week 1 (next year)
               (2014 12 30 . "01") ; Tuesday, week 1 (next year)
               (2014 12 31 . "01") ; Wednesday, week 1 (next year)
               (2015 1 1   . "01") ; Thursday, week 1
               (2015 1 2   . "01") ; Friday, week 1
               (2015 1 3   . "01") ; Saturday, week 1
               (2015 1 4   . "01") ; Sunday, week 1
               (2015 1 5   . "02") ; Monday, week 2
               )))
  (for-each
   (lambda (date)
     (let ((p (open-output-string)))
       (display "date->string ~V " p)
       (write date p)
       (test "srfi 19 date->string"
             (cdddr date)
             (date->string (make-date 0 0 0 0
                                      (caddr date) (cadr date) (car date)
                                      0)
                           "~V"))))
   dates))





;; Some extra tests
;; -- jpellegrini
;;



(test "srfi-19 current time increases monotonically"
      #t
      (time<? (current-time 'time-monotonic)
              (current-time 'time-monotonic)))

(let ((d (make-date 05     ; nano
                    10     ; sec
                    15     ; min
                    20     ; hour
                    25     ; day
                    06     ; month
                    2000   ; year
                   -10800))) ; offset
  (test "srfi-19 date?" #t (date? d))
  (test "srfi-19 date nanosecond" 05 (date-nanosecond d))
  (test "srfi-19 date second"     10 (date-second d))
  (test "srfi-19 date minute"     15 (date-minute d))
  (test "srfi-19 date hour"       20 (date-hour d))
  (test "srfi-19 date day"        25 (date-day d))
  (test "srfi-19 date month"      06 (date-month d))
  (test "srfi-19 date year"     2000 (date-year d))
  (test "srfi-19 date offset" -10800 (date-zone-offset d))

  (let ((m (date->time-monotonic d)))
    (test "srfi 19 date conversions 1" #t (time? m))
    (test "srfi 19 date conversions 2" 'time-monotonic (time-type m))
    #;(test "srfi 19 date conversions 3" #t (equal? d (time-monotonic->date m)))
    (test "srfi 19 date conversions 4" #t (time? (time-monotonic->time-tai m)))
    (test "srfi 19 date conversions 5" 'time-tai (time-type (time-monotonic->time-tai m)))
    #;(test "srfi 19 date conversions 6" #t (equal? (time-tai->date (time-monotonic->time-tai m))
                                                  d)))
  (let ((m (date->time-utc d)))
    (test "srfi 19 date conversions 7" #t (time? m))
    (test "srfi 19 date conversions 8" 'time-utc (time-type m))
    (test "srfi 19 date conversions 9" #t (date=? d (time-utc->date m)))
    (test "srfi 19 date conversions 10" #t (time? (time-utc->time-tai m)))
    (test "srfi 19 date conversions 11" 'time-tai (time-type (time-utc->time-tai m)))
    (test "srfi 19 date conversions 12" #t (date=? (time-tai->date (time-utc->time-tai m))
                                                   d)))
  (let ((m (date->time-tai d)))
    (test "srfi 19 date conversions 13" #t (time? m))
    (test "srfi 19 date conversions 14" 'time-tai (time-type m))
    (test "srfi 19 date conversions 15" #t (date=? d (time-tai->date m)))
    (test "srfi 19 date conversions 16" #t (time? (time-tai->time-utc m)))
    (test "srfi 19 date conversions 17" 'time-utc (time-type (time-tai->time-utc m)))
    (test "srfi 19 date conversions 18" #t (date=? (time-utc->date (time-tai->time-utc m))
                                                   d))))


(test/error "srfi 19 wrong args to make-date 1"
            (make-date 05     ; nano
                       10     ; sec
                       90     ; min   -- WRONG
                       20     ; hour
                       25     ; day
                       06     ; month
                       2000   ; year
                       -10800))

(test/error "srfi 19 wrong args to make-date 2"
            (make-date 05     ; nano
                       10     ; sec
                       15     ; min
                       20     ; hour
                       25     ; day
                       20     ; month - -WRONG
                       2000   ; year
                       -10800))

(test/error "srfi 19 wrong args to make-date 3"
            (make-date 05     ; nano
                       10     ; sec
                       'a     ; min  -- WRONG
                       20     ; hour
                       25     ; day
                       06     ; month
                       2000   ; year
                       -10800))

(test/error "srfi 19 wrong args to make-date 3"
            (make-date 05     ; nano
                       10     ; sec
                       15     ; min
                       1+1i   ; hour -- WRONG
                       25     ; day
                       06     ; month
                       2000   ; year
                       -10800))

(test/error "srfi 19 wrong args to make-date 3"
            (make-date 05     ; nano
                       10     ; sec
                       15     ; min
                       20     ; hour
                       25     ; day
                       2/3    ; month -- WRONG
                       2000   ; year
                       -10800))
