Move all test code into one file.
This commit is contained in:
@@ -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)))
|
||||
|
||||
|
||||
@@ -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)))
|
||||
@@ -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)))
|
||||
@@ -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)))
|
||||
158
tests/model.lisp
158
tests/model.lisp
@@ -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."))))
|
||||
325
tests/test.lisp
Normal file
325
tests/test.lisp
Normal file
@@ -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."))))
|
||||
Reference in New Issue
Block a user