clic/3rdparties/software/alexandria-20200427-git/alexandria-2/tests.lisp

3rdparties/software/alexandria-20200427-git/alexandria-2/tests.lisp (3078 bytes)
1 (in-package :cl-user)
2 
3 (defpackage :alexandria2-tests
4   (:use :cl :alexandria-2 #+sbcl :sb-rt #-sbcl :rtest)
5   (:import-from #+sbcl :sb-rt #-sbcl :rtest
6                 #:*compile-tests* #:*expected-failures*))
7 
8 (in-package :alexandria2-tests)
9 
10 (deftest delete-from-plist*.middle
11     (let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
12       (multiple-value-list (delete-from-plist* input 'b 'c)))
13   ((a 1 d 4 d 5)
14    ((c . 3) (b . 2))))
15 
16 (deftest delete-from-plist*.start
17     (let ((input (list 'a 1 'b 2 'c 3 'd 4 'd 5)))
18       (multiple-value-list (delete-from-plist* input 'a 'c)))
19   ((b 2 d 4 d 5)
20    ((c . 3) (a . 1))))
21 
22 
23 ;; Control Flow tests
24 
25 (deftest line-up-first.no-form
26     (values
27      (equal (macroexpand '(line-up-first 5))
28             5)
29      (equal (macroexpand '(line-up-first (+ 1 2)))
30             '(+ 1 2)))
31   t
32   t)
33 
34 (deftest line-up-first.function-names-are-threaded
35     (values
36      (equal (macroexpand '(line-up-first 5 -))
37             '(- 5))
38      (equal (macroexpand '(line-up-first (+ 1 2) -))
39             '(- (+ 1 2))))
40   t
41   t)
42 
43 (deftest line-up-first.list-promotion
44     (macroexpand '(line-up-first
45                    5
46                    (+ 20)
47                    (/ 25)
48                    -
49                    (+ 40)))
50   (+ (- (/ (+ 5 20) 25)) 40)
51   t)
52 
53 (deftest line-up-first.multiple-args
54     (macroexpand '(line-up-first
55                    "this-is-a-string"
56                    (subseq 0 4)))
57   (subseq "this-is-a-string" 0 4)
58   t)
59 
60 (deftest line-up-first.several-examples
61     (values
62      (equal (line-up-first (+ 40 2)) 42)
63      (equal (line-up-first
64              5
65              (+ 20)
66              (/ 25)
67              -
68              (+ 40)) 39)
69      (equal (line-up-first
70              "this-is-a-string"
71              (subseq 4 5)
72              (string-trim  "--------good"))
73             "good"))
74   t
75   t
76   t)
77 
78 ;; Thread last tests
79 
80 (deftest line-up-last.no-forms
81     (values
82      (equal (macroexpand '(line-up-last 5)) 5)
83      (equal (macroexpand '(line-up-last (+ 1 2))) '(+ 1 2)))
84   t
85   t)
86 
87 (deftest line-up-last.function-names-are-threaded
88     (values (equal (macroexpand
89                     '(line-up-last 5
90                       -))
91                    '(- 5))
92             (equal (macroexpand
93                     '(line-up-last (+ 1 2)
94                       -))
95                    '(- (+ 1 2))))
96   t
97   t)
98 
99 (deftest line-up-last.lisp-promotion
100     (macroexpand '(line-up-last
101                    5
102                    (+ 20)
103                    (/ 25)
104                    -
105                    (+ 40)))
106   (+ 40 (- (/ 25 (+ 20 5))))
107   t)
108 
109 (deftest line-up-last.several-examples
110     (values (equal (line-up-last (+ 40 2)) 42)
111             (equal (line-up-last
112                     5
113                     (+ 20)
114                     (/ 25)
115                     -
116                     (+ 40))
117                    39)
118             (equal (line-up-last
119                     (list 1 -2 3 -4 5)
120                     (mapcar #'abs)
121                     (reduce #'+)
122                     (format nil "abs sum is: ~D"))
123                    "abs sum is: 15"))
124   t
125   t
126   t)