(eval-when (:compile-toplevel :load-toplevel :execute)
  (setf *readtable* (copy-readtable nil)))

(in-package "COM.INFORMATIMAGO.SMALL-CL-PGMS.BOTVOT")
(eval-when (:compile-toplevel :load-toplevel :execute)
  (use-package "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST"))

(define-test test/serialize ()
  (assert-true  (string= (with-output-to-string (out)
                     (princ "(list" out)
                     (serialize (choice "pgc1" "yes" "Yes, obj always reachable.") out)
                     (serialize (choice "pgc1" "no"  "No, obj may be GCed.") out)
                     (serialize (choice "pgc1" "what"  "What are presentations?") out)
                     (princ ")" out))
                   "(list(choice \"pgc1\" \"yes\" \"Yes, obj always reachable.\")(choice \"pgc1\" \"no\" \"No, obj may be GCed.\")(choice \"pgc1\" \"what\" \"What are presentations?\"))"))
  (assert-true  (string= (with-output-to-string (out)
                     (serialize (make-instance 'vote :ballot-id "pgc1"
                                                     :choice-id "yes"
                                                     :user-id "pjb")
                                out))
                   "(vote \"pgc1\" \"0af3a45d6dc7ee8efc3a7aae3f6c33d21d0321776d73aa996060ec35c26cc0a7\" \"yes\" \"5c2031740cd336081cdfbb96b53b12920005aad6334ee070878f7d4dd27ff8a1\")")))

(define-test test/parse-time ()
  (assert-true  (= (parse-time '("12:00"))        43200))
  (assert-true  (= (parse-time '("12:00:00"))     43200))
  (assert-true  (= (parse-time '("00:00:00"))         0))
  (assert-true  (= (parse-time '("00:00"))            0))
  (assert-true  (= (parse-time '("10:30"))        37800))
  (assert-true  (= (parse-time '("10:30:33"))     37833))
  (assert-true  (= (parse-time '("1:2:3"))         3723))
  (assert-true  (= (parse-time '("1" "hour"))      3600))
  (assert-true  (= (parse-time '("1" "hours"))     3600))
  (assert-true  (= (parse-time '("1" "oclock"))    3600))
  (assert-true  (= (parse-time '("1" "o'clock"))   3600)))

(define-test test/parse-deadline ()
    ;; on mon|tue|wed|thi|fri|sat|sun at $h [hours|o'clock]
    ;; on mon|tue|wed|thi|fri|sat|sun at $HH:MM
    ;; at $h [hours|o'clock]
    ;; at $HH:MM
    (assert-true  (equal (parse-deadline '("in" "1"    "d"))       '(:relative 86400)))
  (assert-true  (equal (parse-deadline '("in" "1"    "day"))     '(:relative 86400)))
  (assert-true  (equal (parse-deadline '("in" "1"    "days"))    '(:relative 86400)))
  (assert-true  (equal (parse-deadline '("in" "1"    "h"))       '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "1"    "hour"))    '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "1"    "hours"))   '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "60"   "m"))       '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "60"   "min"))     '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "60"   "minute"))  '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "60"   "minutes")) '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "3600" "s"))       '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "3600" "sec"))     '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "3600" "second"))  '(:relative 3600)))
  (assert-true  (equal (parse-deadline '("in" "3600" "seconds")) '(:relative 3600)))
  (assert-true  (parse-deadline '("on" "mon" "at" "12" "o'clock")))
  (assert-true  (parse-deadline '("on" "Tuesday" "at" "12" "o'clock")))
  (assert-true  (parse-deadline '("at" "12" "o'clock")))
  (assert-true  (parse-deadline '("at" "12" "oclock")))
  (assert-true  (parse-deadline '("at" "12" "hours")))
  (assert-true  (parse-deadline '("at" "12" "hour")))
  (assert-true  (parse-deadline '("at" "12:00")))
  (assert-true  (parse-deadline '("at" "12:00:00")))
  (assert-true  (= (parse-deadline '("at" "12" "o'clock"))
             (parse-deadline '("at" "12" "oclock"))
             (parse-deadline '("at" "12" "hours"))
             (parse-deadline '("at" "12" "hour"))
             (parse-deadline '("at" "12:00"))
             (parse-deadline '("at" "12:00:00")))))

(define-test test/command-matches ()
  (assert-true  (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                           '("set")))
  (assert-true  (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                           '("ballot")))
  (assert-true  (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                           '("title")))
  (assert-true  (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                           '("ballot" "title")))
  (assert-true  (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                           '("set" "ballot" "title")))
  (assert-true  (not (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                                '("vote" "ballot"))))
  (assert-true  (not (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                                '("set" "ballot" "title" "pg1"))))
  (assert-true  (not (command-matches-approximatively '("set" (opt "ballot") "title" ballot-id title)
                                                '("set" "ballot" "title" "pg1"  "Presentation Garbage Collection"))))
  (assert-true  (not (command-matches-exactly '("set" (opt "ballot") "title" ballot-id title)
                                        '("set" "ballot" "title" "pg1"))))
  (assert-true  (command-matches-exactly '("set" (opt "ballot") "title" ballot-id title)
                                   '("set" "ballot" "title" "pg1"  "Presentation Garbage Collection")))
  (assert-true  (equalp (multiple-value-list (command-matches-exactly '("set" (opt "ballot") "title" ballot-id title)
                                                                '("set" "ballot" "title" "pg1"  "Presentation Garbage Collection")))
                  '(t ((title . "Presentation Garbage Collection") (ballot-id . "pg1")))))
  (assert-true  (command-matches-exactly '("set" (opt "ballot") "title" ballot-id title)
                                   '("set" "title" "pg1"  "Presentation Garbage Collection")))
  (assert-true  (equalp (multiple-value-list (command-matches-exactly '("set" (opt "ballot") "title" ballot-id title)
                                                                '("set" "title" "pg1"  "Presentation Garbage Collection")))
                  '(t ((title . "Presentation Garbage Collection") (ballot-id . "pg1"))))))

(define-test test/parse-words ()
  (assert-true  (equal (parse-words "goldorak")
                       '("goldorak")))
  (assert-true  (equal (parse-words "gold orak")
                       '("gold" "orak")))
  (assert-true  (equal (parse-words "  gold   orak  ")
                       '("gold" "orak")))
  (assert-true  (equal (parse-words "gold orak & acta rus")
                       '("gold" "orak" "&" "acta" "rus")))
  (assert-true  (equal (parse-words "\"gold orak\" & \"acta rus\"")
                       '("gold orak" "&" "acta rus")))
  (assert-true  (equal (parse-words "\"gold \\\"orak\\\"\" & \"acta rus\"")
                       '("gold \"orak\"" "&" "acta rus")))
  (assert-true  (equal (parse-words " \"goldorak & actarus\" ")
                       '("goldorak & actarus")))
  (assert-true  (handler-case (parse-words " \"goldorak & actarus")
                  (:no-error (&rest results)
                    (declare (ignore results))
                    nil)
                  (error ()
                    t))))

(define-test test/all ()
  (test/serialize)
  (test/parse-time)
  (test/parse-deadline)
  (test/command-matches)
  (test/parse-words))
ViewGit