diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/ChangeLog | 5 | ||||
| -rw-r--r-- | test/automated/cl-generic-tests.el | 31 |
2 files changed, 26 insertions, 10 deletions
diff --git a/test/ChangeLog b/test/ChangeLog index 15baf866f37..e81bfa7d185 100644 --- a/test/ChangeLog +++ b/test/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2015-01-18 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * automated/cl-generic-tests.el (cl-generic-test-10-weird): New test. | ||
| 4 | Rename other tests to preserve ordering. | ||
| 5 | |||
| 1 | 2015-01-18 Leo Liu <sdl.web@gmail.com> | 6 | 2015-01-18 Leo Liu <sdl.web@gmail.com> |
| 2 | 7 | ||
| 3 | * automated/seq-tests.el (test-seq-subseq): Add more tests. | 8 | * automated/seq-tests.el (test-seq-subseq): Add more tests. |
diff --git a/test/automated/cl-generic-tests.el b/test/automated/cl-generic-tests.el index 46397fb7f51..1c01d9b164b 100644 --- a/test/automated/cl-generic-tests.el +++ b/test/automated/cl-generic-tests.el | |||
| @@ -29,12 +29,12 @@ | |||
| 29 | (cl-defgeneric cl--generic-1 (x y)) | 29 | (cl-defgeneric cl--generic-1 (x y)) |
| 30 | (cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.") | 30 | (cl-defgeneric (setf cl--generic-1) (v y z) "My generic doc.") |
| 31 | 31 | ||
| 32 | (ert-deftest cl-generic-test-0 () | 32 | (ert-deftest cl-generic-test-00 () |
| 33 | (cl-defgeneric cl--generic-1 (x y)) | 33 | (cl-defgeneric cl--generic-1 (x y)) |
| 34 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) | 34 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) |
| 35 | (should (equal (cl--generic-1 'a 'b) '(a . b)))) | 35 | (should (equal (cl--generic-1 'a 'b) '(a . b)))) |
| 36 | 36 | ||
| 37 | (ert-deftest cl-generic-test-1-eql () | 37 | (ert-deftest cl-generic-test-01-eql () |
| 38 | (cl-defgeneric cl--generic-1 (x y)) | 38 | (cl-defgeneric cl--generic-1 (x y)) |
| 39 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) | 39 | (cl-defmethod cl--generic-1 ((x t) y) (cons x y)) |
| 40 | (cl-defmethod cl--generic-1 ((_x (eql 4)) _y) | 40 | (cl-defmethod cl--generic-1 ((_x (eql 4)) _y) |
| @@ -53,7 +53,7 @@ | |||
| 53 | (cl-defstruct (cl-generic-struct-child11 (:include cl-generic-struct-child1)) d) | 53 | (cl-defstruct (cl-generic-struct-child11 (:include cl-generic-struct-child1)) d) |
| 54 | (cl-defstruct (cl-generic-struct-child2 (:include cl-generic-struct-parent)) e) | 54 | (cl-defstruct (cl-generic-struct-child2 (:include cl-generic-struct-parent)) e) |
| 55 | 55 | ||
| 56 | (ert-deftest cl-generic-test-2-struct () | 56 | (ert-deftest cl-generic-test-02-struct () |
| 57 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | 57 | (cl-defgeneric cl--generic-1 (x y) "My doc.") |
| 58 | (cl-defmethod cl--generic-1 ((x t) y) "Doc 1." (cons x y)) | 58 | (cl-defmethod cl--generic-1 ((x t) y) "Doc 1." (cons x y)) |
| 59 | (cl-defmethod cl--generic-1 ((_x cl-generic-struct-parent) y) | 59 | (cl-defmethod cl--generic-1 ((_x cl-generic-struct-parent) y) |
| @@ -73,7 +73,7 @@ | |||
| 73 | (should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil) | 73 | (should (equal (cl--generic-1 (make-cl-generic-struct-child11) nil) |
| 74 | '("child11" "around""child1" "parent" a)))) | 74 | '("child11" "around""child1" "parent" a)))) |
| 75 | 75 | ||
| 76 | (ert-deftest cl-generic-test-3-setf () | 76 | (ert-deftest cl-generic-test-03-setf () |
| 77 | (cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z)) | 77 | (cl-defmethod (setf cl--generic-1) (v (y t) z) (list v y z)) |
| 78 | (cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z)) | 78 | (cl-defmethod (setf cl--generic-1) (v (_y (eql 4)) z) (list v "four" z)) |
| 79 | (should (equal (setf (cl--generic-1 'a 'b) 'v) '(v a b))) | 79 | (should (equal (setf (cl--generic-1 'a 'b) 'v) '(v a b))) |
| @@ -85,7 +85,7 @@ | |||
| 85 | '(v a b))) | 85 | '(v a b))) |
| 86 | (should (equal x '(3 2 1))))) | 86 | (should (equal x '(3 2 1))))) |
| 87 | 87 | ||
| 88 | (ert-deftest cl-generic-test-4-overlapping-tagcodes () | 88 | (ert-deftest cl-generic-test-04-overlapping-tagcodes () |
| 89 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | 89 | (cl-defgeneric cl--generic-1 (x y) "My doc.") |
| 90 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) | 90 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) |
| 91 | (cl-defmethod cl--generic-1 ((_y (eql 4)) _z) | 91 | (cl-defmethod cl--generic-1 ((_y (eql 4)) _z) |
| @@ -98,7 +98,7 @@ | |||
| 98 | (should (equal (cl--generic-1 1 'b) '("integer" "number" 1 b))) | 98 | (should (equal (cl--generic-1 1 'b) '("integer" "number" 1 b))) |
| 99 | (should (equal (cl--generic-1 4 'b) '("four" "integer" "number" 4 b)))) | 99 | (should (equal (cl--generic-1 4 'b) '("four" "integer" "number" 4 b)))) |
| 100 | 100 | ||
| 101 | (ert-deftest cl-generic-test-5-alias () | 101 | (ert-deftest cl-generic-test-05-alias () |
| 102 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | 102 | (cl-defgeneric cl--generic-1 (x y) "My doc.") |
| 103 | (defalias 'cl--generic-2 #'cl--generic-1) | 103 | (defalias 'cl--generic-2 #'cl--generic-1) |
| 104 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) | 104 | (cl-defmethod cl--generic-1 ((y t) z) (list y z)) |
| @@ -106,7 +106,7 @@ | |||
| 106 | (cons "four" (cl-call-next-method))) | 106 | (cons "four" (cl-call-next-method))) |
| 107 | (should (equal (cl--generic-1 4 'b) '("four" 4 b)))) | 107 | (should (equal (cl--generic-1 4 'b) '("four" 4 b)))) |
| 108 | 108 | ||
| 109 | (ert-deftest cl-generic-test-6-multiple-dispatch () | 109 | (ert-deftest cl-generic-test-06-multiple-dispatch () |
| 110 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | 110 | (cl-defgeneric cl--generic-1 (x y) "My doc.") |
| 111 | (cl-defmethod cl--generic-1 (x y) (list x y)) | 111 | (cl-defmethod cl--generic-1 (x y) (list x y)) |
| 112 | (cl-defmethod cl--generic-1 (_x (_y integer)) | 112 | (cl-defmethod cl--generic-1 (_x (_y integer)) |
| @@ -117,7 +117,7 @@ | |||
| 117 | (cons "x&y-int" (cl-call-next-method))) | 117 | (cons "x&y-int" (cl-call-next-method))) |
| 118 | (should (equal (cl--generic-1 1 2) '("x&y-int" "x-int" "y-int" 1 2)))) | 118 | (should (equal (cl--generic-1 1 2) '("x&y-int" "x-int" "y-int" 1 2)))) |
| 119 | 119 | ||
| 120 | (ert-deftest cl-generic-test-7-apo () | 120 | (ert-deftest cl-generic-test-07-apo () |
| 121 | (cl-defgeneric cl--generic-1 (x y) | 121 | (cl-defgeneric cl--generic-1 (x y) |
| 122 | (:documentation "My doc.") (:argument-precedence-order y x)) | 122 | (:documentation "My doc.") (:argument-precedence-order y x)) |
| 123 | (cl-defmethod cl--generic-1 (x y) (list x y)) | 123 | (cl-defmethod cl--generic-1 (x y) (list x y)) |
| @@ -129,7 +129,7 @@ | |||
| 129 | (cons "x&y-int" (cl-call-next-method))) | 129 | (cons "x&y-int" (cl-call-next-method))) |
| 130 | (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2)))) | 130 | (should (equal (cl--generic-1 1 2) '("x&y-int" "y-int" "x-int" 1 2)))) |
| 131 | 131 | ||
| 132 | (ert-deftest cl-generic-test-8-after/before () | 132 | (ert-deftest cl-generic-test-08-after/before () |
| 133 | (let ((log ())) | 133 | (let ((log ())) |
| 134 | (cl-defgeneric cl--generic-1 (x y)) | 134 | (cl-defgeneric cl--generic-1 (x y)) |
| 135 | (cl-defmethod cl--generic-1 ((_x t) y) (cons y log)) | 135 | (cl-defmethod cl--generic-1 ((_x t) y) (cons y log)) |
| @@ -144,7 +144,7 @@ | |||
| 144 | 144 | ||
| 145 | (defun cl--generic-test-advice (&rest args) (cons "advice" (apply args))) | 145 | (defun cl--generic-test-advice (&rest args) (cons "advice" (apply args))) |
| 146 | 146 | ||
| 147 | (ert-deftest cl-generic-test-9-advice () | 147 | (ert-deftest cl-generic-test-09-advice () |
| 148 | (cl-defgeneric cl--generic-1 (x y) "My doc.") | 148 | (cl-defgeneric cl--generic-1 (x y) "My doc.") |
| 149 | (cl-defmethod cl--generic-1 (x y) (list x y)) | 149 | (cl-defmethod cl--generic-1 (x y) (list x y)) |
| 150 | (advice-add 'cl--generic-1 :around #'cl--generic-test-advice) | 150 | (advice-add 'cl--generic-1 :around #'cl--generic-test-advice) |
| @@ -155,5 +155,16 @@ | |||
| 155 | (advice-remove 'cl--generic-1 #'cl--generic-test-advice) | 155 | (advice-remove 'cl--generic-1 #'cl--generic-test-advice) |
| 156 | (should (equal (cl--generic-1 4 5) '("integer" 4 5)))) | 156 | (should (equal (cl--generic-1 4 5) '("integer" 4 5)))) |
| 157 | 157 | ||
| 158 | (ert-deftest cl-generic-test-10-weird () | ||
| 159 | (cl-defgeneric cl--generic-1 (x &rest r) "My doc.") | ||
| 160 | (cl-defmethod cl--generic-1 (x &rest r) (cons x r)) | ||
| 161 | ;; This kind of definition is not valid according to CLHS, but it does show | ||
| 162 | ;; up in EIEIO's tests for no-next-method, so we should either | ||
| 163 | ;; detect it and signal an error or do something meaningful with it. | ||
| 164 | (cl-defmethod cl--generic-1 (x (y integer) &rest r) | ||
| 165 | `("integer" ,y ,x ,@r)) | ||
| 166 | (should (equal (cl--generic-1 'a 'b) '(a b))) | ||
| 167 | (should (equal (cl--generic-1 1 2) '("integer" 2 1)))) | ||
| 168 | |||
| 158 | (provide 'cl-generic-tests) | 169 | (provide 'cl-generic-tests) |
| 159 | ;;; cl-generic-tests.el ends here | 170 | ;;; cl-generic-tests.el ends here |