diff options
| author | Aryadev Chavali <aryadev@aryadevchavali.com> | 2025-03-01 20:09:44 +0000 | 
|---|---|---|
| committer | Aryadev Chavali <aryadev@aryadevchavali.com> | 2025-03-02 01:17:56 +0000 | 
| commit | 93790fad8847632654d6220a6a71bfbf4c867775 (patch) | |
| tree | abd4c38e982184dc433b24cc030dd73bf2af9217 | |
| parent | 191ef054015143a73e214a49f07b01ec7b2ea75b (diff) | |
| download | cantedraw-93790fad8847632654d6220a6a71bfbf4c867775.tar.gz cantedraw-93790fad8847632654d6220a6a71bfbf4c867775.tar.bz2 cantedraw-93790fad8847632654d6220a6a71bfbf4c867775.zip  | |
Move all test code into one file.
| -rw-r--r-- | cantedraw.asd | 7 | ||||
| -rw-r--r-- | tests/functions.lisp | 115 | ||||
| -rw-r--r-- | tests/macros.lisp | 64 | ||||
| -rw-r--r-- | tests/main.lisp | 26 | ||||
| -rw-r--r-- | tests/model.lisp | 158 | ||||
| -rw-r--r-- | tests/test.lisp | 325 | 
6 files changed, 326 insertions, 369 deletions
diff --git a/cantedraw.asd b/cantedraw.asd index d7b8855..617a0ce 100644 --- a/cantedraw.asd +++ b/cantedraw.asd @@ -25,12 +25,7 @@                 :parachute)    :components ((:module "tests"                  :components -                ((:file "macros") -                 (:file "functions") -                 (:file "model") -                 ;; (:file "player") -                 ;; (:file "game") -                 (:file "main")))) +                ((:file "test"))))    :perform (test-op (op c) (uiop:symbol-call :parachute :test                                               :cantedraw/tests/main))) diff --git a/tests/functions.lisp b/tests/functions.lisp deleted file mode 100644 index 11d8f6e..0000000 --- a/tests/functions.lisp +++ /dev/null @@ -1,115 +0,0 @@ -;;; functions.lisp - 2025-02-20 - -;; Copyright (C) 2025 Aryadev Chavali - -;; This program is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for -;; details. - -;; You may distribute and modify this code under the terms of the GNU General -;; Public License Version 2, which you should have received a copy of along with -;; this program.  If not, please go to <https://www.gnu.org/licenses/>. - -;;; Code: - -(defpackage cantedraw/tests/functions -  (:use -   :cl :parachute :cantedraw.lib.macros -   :cantedraw.lib.functions)) - -(in-package :cantedraw/tests/functions) - -(define-test function-test) - -(define-test (function-test "parse-integer*") -  :compile-at :execute -  (is eq 2    (parse-integer* "2")) -  (is eq 2048 (parse-integer* "2048abcdef")) -  (is eq nil    (parse-integer* "a2048abcdef")) -  (is eq nil    (parse-integer* "garbage")) -  (fail       (parse-integer* nil))) - -(define-test (function-test range) -  :compile-at :execute -  (fail (range 1 0)) -  (fail (range nil nil)) -  (fail (range "a" "b")) -  (true (null (range 1 1))) -  (is equal '(1 2 3 4)    (range 1 5)) -  (is equal '(-3 -2 -1 0) (range -3 1))) - -(define-test (function-test take) -  :depends-on ((cantedraw/tests/macros ->>)) -  :compile-at :execute -  (fail (take nil nil)) -  (fail (take 100 nil)) -  (fail (take nil 100)) -  (true (->> (list 1 2 3 4) (take 0) null)) -  (is equal "H" (take 1 "Hello")) -  (is equal '(1 2) (take 2 '(1 2 3 4 5)))) - -(define-test (function-test split) -  :compile-at :execute -  (fail (split nil nil)) -  (fail (split 100 nil)) -  (fail (split nil 100)) -  (is-values (split 0 '(1 2 3 4)) -    (eq nil) -    (equal '(1 2 3 4))) -  (is-values (split 1 '(1 2 3 4)) -    (equal '(1)) -    (equal '(2 3 4))) -  (is-values (split 5 "Hello World") -    (string= "Hello") -    (string= " World"))) - -(define-test (function-test rev-map) -  :depends-on (range -               (cantedraw/tests/macros ->>)) -  :compile-at :execute -  (fail (rev-map nil nil)) -  (fail (rev-map "a string" "another string" :key-eq "not a function")) -  (true (->> nil (rev-map #'identity) null)) -  (let ((res (rev-map #'evenp (range 1 7)))) -    (false (null res)) -    (is equal 2 (length res)) -    (is equal 3 (->> (assoc t res) cdr length)) -    (is equal 3 (->> (assoc nil res) cdr length)) -    (true (->> (assoc t res) cdr (every #'evenp))) -    (true (->> (assoc nil res) cdr (every #'oddp)))) -  (let* ((mod* (lambda (n) (mod n 3))) -         (res (rev-map mod* (range 1 12)))) -    (false (null res)) -    (is equal 3 (length res)) -    (is equal 3 (->> (assoc 0 res) cdr length)) -    (is equal 4 (->> (assoc 1 res) cdr length)) -    (is equal 4 (->> (assoc 2 res) cdr length)) -    (true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0))))) -    (true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1))))) -    (true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2)))))) -  (let ((res (rev-map #'identity "lots of letters"))) -    (false (null res)) -    (is equal 2 (->> (assoc #\l res) cdr length)) -    (is equal 3 (->> (assoc #\t res) cdr length)) -    (is equal 2 (->> (assoc #\space res) cdr length)) -    (is equal 2 (->> (assoc #\s res) cdr length)))) - -(define-test (function-test remove-at-indices) -  :depends-on (range) -  :compile-at :execute -  (fail (remove-at-indices "a string" "another string")) -  (true (null (remove-at-indices nil nil))) -  (is equal '(1 2 3) (remove-at-indices nil '(1 2 3))) -  (is equal '(2) (remove-at-indices '(0 2) '(1 2 3))) -  (let* ((inp (range 100 200)) -         (t1 (remove-at-indices (range 0 100 2) inp)) -         (t2 (remove-at-indices (range 1 100 2) inp))) -    (is equal 50 (length t1)) -    (is equal 50 (length t2)) -    (true (every (lambda (n) (not (member n t2))) t1)) -    (true (every (lambda (n) (not (member n t1))) t2))) -  (let* ((indices (list 0 5 6 7 8 9 10)) -         (str-lst (remove-at-indices indices "Hello World")) -         (ret (coerce str-lst 'string))) -    (is string= "ello" ret))) diff --git a/tests/macros.lisp b/tests/macros.lisp deleted file mode 100644 index 5e0a1fb..0000000 --- a/tests/macros.lisp +++ /dev/null @@ -1,64 +0,0 @@ -;;; main.lisp - 2025-02-16 - -;; Copyright (C) 2025 Aryadev Chavali - -;; This program is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for -;; details. - -;; You may distribute and modify this code under the terms of the GNU General -;; Public License Version 2, which you should have received a copy of along with -;; this program.  If not, please go to <https://www.gnu.org/licenses/>. - -;;; Code: - -(defpackage cantedraw/tests/macros -  (:use :cl :cantedraw.lib.macros -        :parachute)) - -(in-package :cantedraw/tests/macros) - -(define-test macro-test) - -(define-test (macro-test "-->") -  (true (null          (--> x))) -  (is eq 'a            (--> x 'a)) -  (is eq 2             (--> x 1 (1+ x))) -  (is eq 2             (--> x 1 1+)) -  (is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6)))) - -(define-test (macro-test "->>") -  (true (null (->>))) -  (let ((a (gensym)) -        (b (gensym)) -        (c (gensym)) -        (d (gensym))) -    (is eq a (->> a)) -    (is equal `(,a ,b)           (macroexpand `(->> ,b (,a)))) -    (is equal `(,a ,b)           (macroexpand `(->> ,b ,a))) -    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c (,b) (,a)))) -    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c ,b ,a))) -    (is equal `(,a ,b ,c)        (macroexpand `(->> ,c (,a ,b)))) -    (is equal `(,a ,b (,c ,d))   (macroexpand `(->> (,c ,d) (,a ,b)))) -    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d (,c) (,b) (,a)))) -    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d ,c ,b ,a)))) -  (is string= "Hello, World!"    (->> "world!" (format nil "hello, ~a") string-capitalize))) - -(define-test (macro-test "-<>") -  (true (null (-<>))) -  (let ((a (gensym)) -        (b (gensym)) -        (c (gensym)) -        (d (gensym))) -    (is eq a (-<> a)) -    (is equal `(,a ,b)           (macroexpand `(-<> ,b (,a)))) -    (is equal `(,a ,b)           (macroexpand `(-<> ,b ,a))) -    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c (,b) (,a)))) -    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c ,b ,a))) -    (is equal `(,a ,b ,c)        (macroexpand `(-<> ,b (,a ,c)))) -    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d (,c) (,b) (,a)))) -    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d ,c ,b ,a))) -    (is equal `(,a (,b ,c) ,d)   (macroexpand `(-<> ,c (,b) (,a ,d))))) -  (is equal 69                   (-<> 489 (- 420))) -  (is string= "HELLO"            (-<> "Hello World!" (subseq 0 5) string-upcase))) diff --git a/tests/main.lisp b/tests/main.lisp deleted file mode 100644 index b68e02f..0000000 --- a/tests/main.lisp +++ /dev/null @@ -1,26 +0,0 @@ -;;; main.lisp - 2025-02-20 - -;; Copyright (C) 2025 Aryadev Chavali - -;; This program is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for -;; details. - -;; You may distribute and modify this code under the terms of the GNU General -;; Public License Version 2, which you should have received a copy of along with -;; this program.  If not, please go to <https://www.gnu.org/licenses/>. - - -;;; Code: - -(defpackage cantedraw/tests/main -  (:use :cl :parachute)) - -(in-package :cantedraw/tests/main) - -(define-test all -  :serial t -  :depends-on ((cantedraw/tests/macros macro-test) -               (cantedraw/tests/functions function-test) -               (cantedraw/tests/model model-test))) diff --git a/tests/model.lisp b/tests/model.lisp deleted file mode 100644 index e5f416d..0000000 --- a/tests/model.lisp +++ /dev/null @@ -1,158 +0,0 @@ -;;; model.lisp - 2025-02-21 - -;; Copyright (C) 2025 Aryadev Chavali - -;; This program is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for -;; details. - -;; You may distribute and modify this code under the terms of the GNU General -;; Public License Version 2, which you should have received a copy of along with -;; this program.  If not, please go to <https://www.gnu.org/licenses/>. - -;;; Code: - -(defpackage cantedraw/tests/model -  (:use -   :cl :parachute -   :cantedraw.lib.macros :cantedraw.lib.functions -   :cantedraw.model)) - -(in-package :cantedraw/tests/model) - -(define-test model-test) - -(define-test (model-test int->rank) -  :depends-on ((cantedraw/tests/macros ->>) -               (cantedraw/tests/functions rev-map)) -  :compile-at :execute -  (fail (int->rank nil)) -  (fail (int->rank "Not a number")) -  ;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed. -  (let ((mapping (rev-map #'int->rank (range 0 52)))) -    ;; Prove there are 13 ranks -    (is eq 13 (length mapping)) -    ;; Prove every rank is equivalent in length. -    (is eq 1 (->> mapping -                  (mapcar ($>> cdr length)) -                  remove-duplicates -                  length)) -    ;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks. -    (true (every #'identity -             (->> (list :ace :king :queen :jack) -                  (append (range 2 11)) -                  (mapcar (lambda (rank) (assoc rank mapping)))))))) - -(define-test (model-test rank->int) -  :depends-on ((cantedraw/tests/macros ->>)) -  :compile-at :execute -  (fail (rank->int nil)) -  (fail (rank->int 1738)) -  (fail (rank->int "not a rank")) -  (fail (rank->int :still-not-a-rank)) -  ;; Prove ranks are mapped to unique positive integers -  (let ((res (->> (list :jack :queen :king :ace) -                  (append (range 2 11)) -                  (mapcar #'rank->int)))) -    (true (every #'integerp res)) -    (true (every #'(lambda (x) (<= 0 x)) res)) -    (is equal (length res) (length (remove-duplicates res))))) - -(define-test (model-test "int->rank and rank->int are complete inverses") -  :depends-on (rank->int int->rank) -  (let ((int-range (range 0 13)) -        (rank-range (->> (list :ace :jack :queen :king) -                         (append (range 2 11))))) -    (is equal rank-range -        (mapcar ($>> rank->int int->rank) rank-range)) -    (is equal int-range -        (mapcar ($>> int->rank rank->int) int-range)))) - -(define-test (model-test int->suit) -  :depends-on ((cantedraw/tests/macros ->>) -               (cantedraw/tests/functions rev-map)) -  :compile-at :execute -  (fail (int->suit nil)) -  (fail (int->suit "Not a number")) -  ;; Proving int->suit splits 0-51 perfectly between the 4 suits -  (let ((mapping (rev-map #'int->suit (range 0 53)))) -    (is eq 5 (length mapping)) -    (let ((spades   (alist-val :spades mapping)) -          (hearts   (alist-val :hearts mapping)) -          (clubs    (alist-val :clubs mapping)) -          (diamonds (alist-val :diamonds mapping)) -          (jokers   (alist-val :joker mapping))) -      (is eq 1 (length jokers)) -      (is eq 1 (->> (list spades hearts clubs diamonds) -                    (mapcar #'length) -                    remove-duplicates -                    length))))) - -(define-test (model-test suit->int) -  :depends-on ((cantedraw/tests/macros ->>)) -  :compile-at :execute -  (fail (suit->int nil)) -  (fail (suit->int "not a suit")) -  (fail (suit->int :still-not-a-suit)) -  (fail (suit->int 42069)) -  ;; Prove suits are mapped to unique positive integers -  (let ((res (->> (list :diamonds :clubs :hearts :spades :joker) -                  (mapcar #'suit->int)))) -    (true (every #'integerp res) "All integers") -    (true (every ($>> (<= 0)) res) "All positive") -    (is equal (length res) (length (remove-duplicates res)) "Unique mapping"))) - -(define-test (model-test "int->suit and suit->int are complete inverses") -  :depends-on (suit->int int->suit) -  (let ((int-range (list 0 13 26 39 52)) -        (suit-range (list :diamonds :clubs :hearts :spades :joker))) -    (is equal suit-range -        (mapcar ($>> suit->int int->suit) suit-range)) -    (is equal int-range -        (mapcar ($>> int->suit suit->int) int-range)))) - -(define-test (model-test int->card) -  :depends-on ((cantedraw/tests/functions range)) -  :compile-at :execute -  (fail (int->card nil)) -  (fail (int->card "Not a number")) -  ;; Proving int->card maps 0-51 to exactly 52 unique cards -  (let ((mapping (mapcar #'int->card (range 0 52)))) -    (is eq 52 (length (remove-duplicates mapping :test #'equal)) -        "52 unique elements.") -    (true (every #'card-p mapping) -          "Every element is a card.")) -  ;; Prove that cards outside of [0, 51] are mapped to jokers (not exhaustive) -  (loop :for positive :from 100 :to 200 -        :for negative :from -200 :to -100 -        :for inp := (mapcar #'int->card (list positive negative)) -        :do (true (every #'card-p inp) -                  "Is a card.") -        :do (true (every (lambda (c) (eq :joker (card-suit c))) inp) -                  "Are jokers."))) - -(define-test (model-test card->int) -  :depends-on ((cantedraw/tests/functions range)) -  :compile-at :execute -  (fail (card->int nil)) -  (fail (card->int 1738)) -  (fail (card->int "not a card")) -  (fail (card->int :still-not-a-card)) -  (let ((ranks (append (range 2 11) (list :jack :queen :king :ace)))) -    (let ((res (->> (loop :for suit :in (list :diamonds :clubs :hearts :spades) -                          :nconc -                          (mapcar (lambda (rank) (make-card :rank rank :suit suit)) ranks)) -                    (mapcar #'card->int)))) -      (true (every #'integerp res) "Every mapped element is an integer.") -      (true (every #'(lambda (x) (<= 0 x)) res) "Every mapped element is positive") -      (is eq (length res) (length (remove-duplicates res)) -          "All mapped integers are unique.")) -    (let ((res (->> (loop :for rank :in ranks -                          :collect (make-card :rank rank :suit :joker)) -                    (mapcar #'card->int)))) -      (true (every #'integerp res) "Every mapped element is an integer.") -      (true (every (lambda (n) (or (< n 0) (> n 51))) res) -            "Every mapped element is outside of [0,51]") -      (is eq (length res) (length (remove-duplicates res)) -          "All mapped integers are unique.")))) diff --git a/tests/test.lisp b/tests/test.lisp new file mode 100644 index 0000000..75e1192 --- /dev/null +++ b/tests/test.lisp @@ -0,0 +1,325 @@ +;;; test.lisp - 2025-03-01 + +;; Copyright (C) 2025 Aryadev Chavali + +;; This program is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +;; FOR A PARTICULAR PURPOSE.  See the GNU General Public License Version 2 for +;; details. + +;; You may distribute and modify this code under the terms of the GNU General +;; Public License Version 2, which you should have received a copy of along with +;; this program.  If not, please go to <https://www.gnu.org/licenses/>. + +;; Packages + +(defpackage cantedraw/tests/main +  (:use :cl :parachute)) + +(defpackage cantedraw/tests/macros +  (:use :cl :parachute +        :cantedraw.lib.macros)) + +(defpackage cantedraw/tests/functions +  (:use :cl :parachute +        :cantedraw.lib.macros :cantedraw.lib.functions)) + +(defpackage cantedraw/tests/model +  (:use :cl :parachute +        :cantedraw.lib.macros :cantedraw.lib.functions +        :cantedraw.model)) + +;; Implementations + +;;; main +(in-package :cantedraw/tests/main) + +(define-test all +  :serial t +  :depends-on ((cantedraw/tests/macros macro-test) +               (cantedraw/tests/functions function-test) +               (cantedraw/tests/model model-test))) + +;;; macros +(in-package :cantedraw/tests/macros) + +(define-test macro-test) + +(define-test (macro-test "-->") +    (true (null          (--> x))) +  (is eq 'a            (--> x 'a)) +  (is eq 2             (--> x 1 (1+ x))) +  (is eq 2             (--> x 1 1+)) +  (is string= "World!" (--> _ "Hello" (format nil "~a World!" _) (subseq _ 6)))) + +(define-test (macro-test "->>") +    (true (null (->>))) +  (let ((a (gensym)) +        (b (gensym)) +        (c (gensym)) +        (d (gensym))) +    (is eq a (->> a)) +    (is equal `(,a ,b)           (macroexpand `(->> ,b (,a)))) +    (is equal `(,a ,b)           (macroexpand `(->> ,b ,a))) +    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c (,b) (,a)))) +    (is equal `(,a (,b ,c))      (macroexpand `(->> ,c ,b ,a))) +    (is equal `(,a ,b ,c)        (macroexpand `(->> ,c (,a ,b)))) +    (is equal `(,a ,b (,c ,d))   (macroexpand `(->> (,c ,d) (,a ,b)))) +    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d (,c) (,b) (,a)))) +    (is equal `(,a (,b (,c ,d))) (macroexpand `(->> ,d ,c ,b ,a)))) +  (is string= "Hello, World!"    (->> "world!" (format nil "hello, ~a") string-capitalize))) + +(define-test (macro-test "-<>") +  (true (null (-<>))) +  (let ((a (gensym)) +        (b (gensym)) +        (c (gensym)) +        (d (gensym))) +    (is eq a (-<> a)) +    (is equal `(,a ,b)           (macroexpand `(-<> ,b (,a)))) +    (is equal `(,a ,b)           (macroexpand `(-<> ,b ,a))) +    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c (,b) (,a)))) +    (is equal `(,a (,b ,c))      (macroexpand `(-<> ,c ,b ,a))) +    (is equal `(,a ,b ,c)        (macroexpand `(-<> ,b (,a ,c)))) +    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d (,c) (,b) (,a)))) +    (is equal `(,a (,b (,c ,d))) (macroexpand `(-<> ,d ,c ,b ,a))) +    (is equal `(,a (,b ,c) ,d)   (macroexpand `(-<> ,c (,b) (,a ,d))))) +  (is equal 69                   (-<> 489 (- 420))) +  (is string= "HELLO"            (-<> "Hello World!" (subseq 0 5) string-upcase))) + +;;; functions +(in-package :cantedraw/tests/functions) + +(define-test function-test) + +(define-test (function-test "parse-integer*") +  :compile-at :execute +  (is eq 2    (parse-integer* "2")) +  (is eq 2048 (parse-integer* "2048abcdef")) +  (is eq nil    (parse-integer* "a2048abcdef")) +  (is eq nil    (parse-integer* "garbage")) +  (fail       (parse-integer* nil))) + +(define-test (function-test range) +  :compile-at :execute +  (fail (range 1 0)) +  (fail (range nil nil)) +  (fail (range "a" "b")) +  (true (null (range 1 1))) +  (is equal '(1 2 3 4)    (range 1 5)) +  (is equal '(-3 -2 -1 0) (range -3 1))) + +(define-test (function-test take) +  :depends-on ((cantedraw/tests/macros ->>)) +  :compile-at :execute +  (fail (take nil nil)) +  (fail (take 100 nil)) +  (fail (take nil 100)) +  (true (->> (list 1 2 3 4) (take 0) null)) +  (is equal "H" (take 1 "Hello")) +  (is equal '(1 2) (take 2 '(1 2 3 4 5)))) + +(define-test (function-test split) +  :compile-at :execute +  (fail (split nil nil)) +  (fail (split 100 nil)) +  (fail (split nil 100)) +  (is-values (split 0 '(1 2 3 4)) +    (eq nil) +    (equal '(1 2 3 4))) +  (is-values (split 1 '(1 2 3 4)) +    (equal '(1)) +    (equal '(2 3 4))) +  (is-values (split 5 "Hello World") +    (string= "Hello") +    (string= " World"))) + +(define-test (function-test rev-map) +  :depends-on (range +               (cantedraw/tests/macros ->>)) +  :compile-at :execute +  (fail (rev-map nil nil)) +  (fail (rev-map "a string" "another string" :key-eq "not a function")) +  (true (->> nil (rev-map #'identity) null)) +  (let ((res (rev-map #'evenp (range 1 7)))) +    (false (null res)) +    (is equal 2 (length res)) +    (is equal 3 (->> (assoc t res) cdr length)) +    (is equal 3 (->> (assoc nil res) cdr length)) +    (true (->> (assoc t res) cdr (every #'evenp))) +    (true (->> (assoc nil res) cdr (every #'oddp)))) +  (let* ((mod* (lambda (n) (mod n 3))) +         (res (rev-map mod* (range 1 12)))) +    (false (null res)) +    (is equal 3 (length res)) +    (is equal 3 (->> (assoc 0 res) cdr length)) +    (is equal 4 (->> (assoc 1 res) cdr length)) +    (is equal 4 (->> (assoc 2 res) cdr length)) +    (true (->> (assoc 0 res) cdr (every (lambda (x) (= (mod x 3) 0))))) +    (true (->> (assoc 1 res) cdr (every (lambda (x) (= (mod x 3) 1))))) +    (true (->> (assoc 2 res) cdr (every (lambda (x) (= (mod x 3) 2)))))) +  (let ((res (rev-map #'identity "lots of letters"))) +    (false (null res)) +    (is equal 2 (->> (assoc #\l res) cdr length)) +    (is equal 3 (->> (assoc #\t res) cdr length)) +    (is equal 2 (->> (assoc #\space res) cdr length)) +    (is equal 2 (->> (assoc #\s res) cdr length)))) + +(define-test (function-test remove-at-indices) +  :depends-on (range) +  :compile-at :execute +  (fail (remove-at-indices "a string" "another string")) +  (true (null (remove-at-indices nil nil))) +  (is equal '(1 2 3) (remove-at-indices nil '(1 2 3))) +  (is equal '(2) (remove-at-indices '(0 2) '(1 2 3))) +  (let* ((inp (range 100 200)) +         (t1 (remove-at-indices (range 0 100 2) inp)) +         (t2 (remove-at-indices (range 1 100 2) inp))) +    (is equal 50 (length t1)) +    (is equal 50 (length t2)) +    (true (every (lambda (n) (not (member n t2))) t1)) +    (true (every (lambda (n) (not (member n t1))) t2))) +  (let* ((indices (list 0 5 6 7 8 9 10)) +         (str-lst (remove-at-indices indices "Hello World")) +         (ret (coerce str-lst 'string))) +    (is string= "ello" ret))) + + +;;; model +(in-package :cantedraw/tests/model) + +(define-test model-test) + +(define-test (model-test int->rank) +  :depends-on ((cantedraw/tests/macros ->>) +               (cantedraw/tests/functions rev-map)) +  :compile-at :execute +  (fail (int->rank nil)) +  (fail (int->rank "Not a number")) +  ;; Proving int->rank maps 0-51 to produces 13 ranks, all equally distributed. +  (let ((mapping (rev-map #'int->rank (range 0 52)))) +    ;; Prove there are 13 ranks +    (is eq 13 (length mapping)) +    ;; Prove every rank is equivalent in length. +    (is eq 1 (->> mapping +                  (mapcar ($>> cdr length)) +                  remove-duplicates +                  length)) +    ;; Prove Ace, 2, ..., 10, Jack, Queen, King are the 13 ranks. +    (true (every #'identity +                 (->> (list :ace :king :queen :jack) +                      (append (range 2 11)) +                      (mapcar (lambda (rank) (assoc rank mapping)))))))) + +(define-test (model-test rank->int) +  :depends-on ((cantedraw/tests/macros ->>)) +  :compile-at :execute +  (fail (rank->int nil)) +  (fail (rank->int 1738)) +  (fail (rank->int "not a rank")) +  (fail (rank->int :still-not-a-rank)) +  ;; Prove ranks are mapped to unique positive integers +  (let ((res (->> (list :jack :queen :king :ace) +                  (append (range 2 11)) +                  (mapcar #'rank->int)))) +    (true (every #'integerp res)) +    (true (every #'(lambda (x) (<= 0 x)) res)) +    (is equal (length res) (length (remove-duplicates res))))) + +(define-test (model-test "int->rank and rank->int are complete inverses") +  :depends-on (rank->int int->rank) +  (let ((int-range (range 0 13)) +        (rank-range (->> (list :ace :jack :queen :king) +                         (append (range 2 11))))) +    (is equal rank-range +        (mapcar ($>> rank->int int->rank) rank-range)) +    (is equal int-range +        (mapcar ($>> int->rank rank->int) int-range)))) + +(define-test (model-test int->suit) +  :depends-on ((cantedraw/tests/macros ->>) +               (cantedraw/tests/functions rev-map)) +  :compile-at :execute +  (fail (int->suit nil)) +  (fail (int->suit "Not a number")) +  ;; Proving int->suit splits 0-51 perfectly between the 4 suits +  (let ((mapping (rev-map #'int->suit (range 0 53)))) +    (is eq 5 (length mapping)) +    (let ((spades   (alist-val :spades mapping)) +          (hearts   (alist-val :hearts mapping)) +          (clubs    (alist-val :clubs mapping)) +          (diamonds (alist-val :diamonds mapping)) +          (jokers   (alist-val :joker mapping))) +      (is eq 1 (length jokers)) +      (is eq 1 (->> (list spades hearts clubs diamonds) +                    (mapcar #'length) +                    remove-duplicates +                    length))))) + +(define-test (model-test suit->int) +  :depends-on ((cantedraw/tests/macros ->>)) +  :compile-at :execute +  (fail (suit->int nil)) +  (fail (suit->int "not a suit")) +  (fail (suit->int :still-not-a-suit)) +  (fail (suit->int 42069)) +  ;; Prove suits are mapped to unique positive integers +  (let ((res (->> (list :diamonds :clubs :hearts :spades :joker) +                  (mapcar #'suit->int)))) +    (true (every #'integerp res) "All integers") +    (true (every ($>> (<= 0)) res) "All positive") +    (is equal (length res) (length (remove-duplicates res)) "Unique mapping"))) + +(define-test (model-test "int->suit and suit->int are complete inverses") +  :depends-on (suit->int int->suit) +  (let ((int-range (list 0 13 26 39 52)) +        (suit-range (list :diamonds :clubs :hearts :spades :joker))) +    (is equal suit-range +        (mapcar ($>> suit->int int->suit) suit-range)) +    (is equal int-range +        (mapcar ($>> int->suit suit->int) int-range)))) + +(define-test (model-test int->card) +  :depends-on ((cantedraw/tests/functions range)) +  :compile-at :execute +  (fail (int->card nil)) +  (fail (int->card "Not a number")) +  ;; Proving int->card maps 0-51 to exactly 52 unique cards +  (let ((mapping (mapcar #'int->card (range 0 52)))) +    (is eq 52 (length (remove-duplicates mapping :test #'equal)) +        "52 unique elements.") +    (true (every #'card-p mapping) +          "Every element is a card.")) +  ;; Prove that cards outside of [0, 51] are mapped to jokers (not exhaustive) +  (loop :for positive :from 100 :to 200 +        :for negative :from -200 :to -100 +        :for inp := (mapcar #'int->card (list positive negative)) +        :do (true (every #'card-p inp) +                  "Is a card.") +        :do (true (every (lambda (c) (eq :joker (card-suit c))) inp) +                  "Are jokers."))) + +(define-test (model-test card->int) +  :depends-on ((cantedraw/tests/functions range)) +  :compile-at :execute +  (fail (card->int nil)) +  (fail (card->int 1738)) +  (fail (card->int "not a card")) +  (fail (card->int :still-not-a-card)) +  (let ((ranks (append (range 2 11) (list :jack :queen :king :ace)))) +    (let ((res (->> (loop :for suit :in (list :diamonds :clubs :hearts :spades) +                          :nconc +                          (mapcar (lambda (rank) (make-card :rank rank :suit suit)) ranks)) +                    (mapcar #'card->int)))) +      (true (every #'integerp res) "Every mapped element is an integer.") +      (true (every #'(lambda (x) (<= 0 x)) res) "Every mapped element is positive") +      (is eq (length res) (length (remove-duplicates res)) +          "All mapped integers are unique.")) +    (let ((res (->> (loop :for rank :in ranks +                          :collect (make-card :rank rank :suit :joker)) +                    (mapcar #'card->int)))) +      (true (every #'integerp res) "Every mapped element is an integer.") +      (true (every (lambda (n) (or (< n 0) (> n 51))) res) +            "Every mapped element is outside of [0,51]") +      (is eq (length res) (length (remove-duplicates res)) +          "All mapped integers are unique."))))  | 
