(require 'cl-lib)
(require 'comp-cstr)
-(defun comp-cstr-test-ts (type-spec)
- "Create a constraint from TYPE-SPEC and convert it back to type specifier."
- (let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
-
-(defun comp-cstr-typespec-test (number type-spec expected-type-spec)
- `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) ()
- (should (equal (comp-cstr-test-ts ',type-spec)
- ',expected-type-spec))))
-
-(defconst comp-cstr-typespec-tests-alist
- `(;; 1
- (symbol . symbol)
- ;; 2
- ((or string array) . array)
- ;; 3
- ((or symbol number) . (or number symbol))
- ;; 4
- ((or cons atom) . (or atom cons)) ;; SBCL return T
- ;; 5
- ((or integer number) . number)
- ;; 6
- ((or (or integer symbol) number) . (or number symbol))
- ;; 7
- ((or (or integer symbol) (or number list)) . (or list number symbol))
- ;; 8
- ((or (or integer number) nil) . number)
- ;; 9
- ((member foo) . (member foo))
- ;; 10
- ((member foo bar) . (member bar foo))
- ;; 11
- ((or (member foo) (member bar)) . (member bar foo))
- ;; 12
- ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
- ;; 13
- ((or (member foo) number) . (or (member foo) number))
- ;; 14
- ((or (integer 1 3) number) . number)
- ;; 15
- (integer . integer)
- ;; 16
- ((integer 1 2) . (integer 1 2))
- ;; 17
- ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
- ;; 18
- ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
- ;; 19
- ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
- ;; 20
- ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
- ;; 21
- ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
- ;; 22
- ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
- ;; 23
- ((or (integer -1 2) (integer * 4)) . (integer * 4))
- ;; 24
- ((and string array) . string)
- ;; 25
- ((and cons atom) . nil)
- ;; 26
- ((and (member foo) (member foo bar baz)) . (member foo))
- ;; 27
- ((and (member foo) (member bar)) . nil)
- ;; 28
- ((and (member foo) symbol) . (member foo))
- ;; 29
- ((and (member foo) string) . nil)
- ;; 30
- ((and (member foo) (integer 1 2)) . nil)
- ;; 31
- ((and (member 1 2) (member 3 2)) . (member 2))
- ;; 32
- ((and number (integer 1 2)) . (integer 1 2))
- ;; 33
- ((and integer (integer 1 2)) . (integer 1 2))
- ;; 34
- ((and (integer -1 0) (integer 3 5)) . nil)
- ;; 35
- ((and (integer -1 2) (integer 3 5)) . nil)
- ;; 36
- ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
- ;; 37
- ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
- ;; 38
- ((and (integer -1 5) nil) . nil)
- ;; 39
- ((not symbol) . (not symbol))
- ;; 40
- ((or (member foo) (not (member foo bar))) . (not (member bar)))
- ;; 41
- ((or (member foo bar) (not (member foo))) . t)
- ;; 42
- ((or symbol (not sequence)) . (not sequence))
- ;; 43
- ((or symbol (not symbol)) . t)
- ;; 44
- ((or symbol (not sequence)) . (not sequence))
- ;; 45 Conservative.
- ((or vector (not sequence)) . t)
- ;; 46
- ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 47
- ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
- ;; 48
- ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
- ;; 49
- ((or symbol (not (member foo))) . (not (member foo)))
- ;; 50
- ((or (not symbol) (not (member foo))) . (not symbol))
- ;; 51 Conservative.
- ((or (not (member foo)) string) . (not (member foo)))
- ;; 52 Conservative.
- ((or (member foo) (not string)) . (not string))
- ;; 53
- ((or (not (integer 1 2)) integer) . integer)
- ;; 54
- ((or (not (integer 1 2)) (not integer)) . (not integer))
- ;; 55
- ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
- ;; 56
- ((or number (not (integer 1 2))) . t)
- ;; 57
- ((or atom (not (integer 1 2))) . t)
- ;; 58
- ((or atom (not (member foo))) . t)
- ;; 59
- ((and symbol (not cons)) . symbol)
- ;; 60
- ((and symbol (not symbol)) . nil)
- ;; 61
- ((and atom (not symbol)) . atom)
- ;; 62
- ((and atom (not string)) . (or array sequence atom))
- ;; 63 Conservative
- ((and symbol (not (member foo))) . symbol)
- ;; 64 Conservative
- ((and symbol (not (member 3))) . symbol)
- ;; 65
- ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
- ;; 66
- ((and (member foo) (not (integer 1 10))) . (member foo))
- ;; 67
- ((and t (not (member foo))) . (not (member foo)))
- ;; 68
- ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
- ;; 69
- ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
- ;; 70
- ((and (not (member a)) (not (member b))) . (not (member b a)))
- ;; 71
- ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
- ;; 72
- ((and t (integer 1 1)) . (integer 1 1))
- ;; 73
- ((not (integer -1 5)) . (not (integer -1 5)))
- ;; 74
- ((and boolean (or number marker)) . nil)
- ;; 75
- ((and atom (or number marker)) . (or marker number))
- ;; 76
- ((and symbol (or number marker)) . nil)
- ;; 77
- ((and (or symbol string) (or number marker)) . nil)
- ;; 78
- ((and t t) . t)
- ;; 80
- ((and (or marker number) (integer 0 0)) . (integer 0 0))
- ;; 81
- ((and t (not t)) . nil)
- ;; 82
- ((or (integer 1 1) (not (integer 1 1))) . t))
- "Alist type specifier -> expected type specifier.")
+(cl-eval-when (compile eval load)
+
+ (defun comp-cstr-test-ts (type-spec)
+ "Create a constraint from TYPE-SPEC and convert it back to type specifier."
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-cstr-to-type-spec (comp-type-spec-to-cstr type-spec))))
+
+ (defun comp-cstr-typespec-test (number type-spec expected-type-spec)
+ `(ert-deftest ,(intern (concat "comp-cstr-test-" (int-to-string number))) ()
+ (should (equal (comp-cstr-test-ts ',type-spec)
+ ',expected-type-spec))))
+
+ (defconst comp-cstr-typespec-tests-alist
+ `(;; 1
+ (symbol . symbol)
+ ;; 2
+ ((or string array) . array)
+ ;; 3
+ ((or symbol number) . (or number symbol))
+ ;; 4
+ ((or cons atom) . (or atom cons)) ;; SBCL return T
+ ;; 5
+ ((or integer number) . number)
+ ;; 6
+ ((or (or integer symbol) number) . (or number symbol))
+ ;; 7
+ ((or (or integer symbol) (or number list)) . (or list number symbol))
+ ;; 8
+ ((or (or integer number) nil) . number)
+ ;; 9
+ ((member foo) . (member foo))
+ ;; 10
+ ((member foo bar) . (member bar foo))
+ ;; 11
+ ((or (member foo) (member bar)) . (member bar foo))
+ ;; 12
+ ((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
+ ;; 13
+ ((or (member foo) number) . (or (member foo) number))
+ ;; 14
+ ((or (integer 1 3) number) . number)
+ ;; 15
+ (integer . integer)
+ ;; 16
+ ((integer 1 2) . (integer 1 2))
+ ;; 17
+ ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
+ ;; 18
+ ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
+ ;; 19
+ ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
+ ;; 20
+ ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
+ ;; 21
+ ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
+ ;; 22
+ ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
+ ;; 23
+ ((or (integer -1 2) (integer * 4)) . (integer * 4))
+ ;; 24
+ ((and string array) . string)
+ ;; 25
+ ((and cons atom) . nil)
+ ;; 26
+ ((and (member foo) (member foo bar baz)) . (member foo))
+ ;; 27
+ ((and (member foo) (member bar)) . nil)
+ ;; 28
+ ((and (member foo) symbol) . (member foo))
+ ;; 29
+ ((and (member foo) string) . nil)
+ ;; 30
+ ((and (member foo) (integer 1 2)) . nil)
+ ;; 31
+ ((and (member 1 2) (member 3 2)) . (member 2))
+ ;; 32
+ ((and number (integer 1 2)) . (integer 1 2))
+ ;; 33
+ ((and integer (integer 1 2)) . (integer 1 2))
+ ;; 34
+ ((and (integer -1 0) (integer 3 5)) . nil)
+ ;; 35
+ ((and (integer -1 2) (integer 3 5)) . nil)
+ ;; 36
+ ((and (integer -1 3) (integer 3 5)) . (integer 3 3))
+ ;; 37
+ ((and (integer -1 4) (integer 3 5)) . (integer 3 4))
+ ;; 38
+ ((and (integer -1 5) nil) . nil)
+ ;; 39
+ ((not symbol) . (not symbol))
+ ;; 40
+ ((or (member foo) (not (member foo bar))) . (not (member bar)))
+ ;; 41
+ ((or (member foo bar) (not (member foo))) . t)
+ ;; 42
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 43
+ ((or symbol (not symbol)) . t)
+ ;; 44
+ ((or symbol (not sequence)) . (not sequence))
+ ;; 45 Conservative.
+ ((or vector (not sequence)) . t)
+ ;; 46
+ ((or (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 47
+ ((or symbol (integer 1 10) (not (integer * 5))) . (not (integer * 0)))
+ ;; 48
+ ((or (not symbol) (integer 1 10) (not (integer * 5))) . (not (or symbol (integer * 0))))
+ ;; 49
+ ((or symbol (not (member foo))) . (not (member foo)))
+ ;; 50
+ ((or (not symbol) (not (member foo))) . (not symbol))
+ ;; 51 Conservative.
+ ((or (not (member foo)) string) . (not (member foo)))
+ ;; 52 Conservative.
+ ((or (member foo) (not string)) . (not string))
+ ;; 53
+ ((or (not (integer 1 2)) integer) . integer)
+ ;; 54
+ ((or (not (integer 1 2)) (not integer)) . (not integer))
+ ;; 55
+ ((or (integer 1 2) (not integer)) . (not (or (integer * 0) (integer 3 *))))
+ ;; 56
+ ((or number (not (integer 1 2))) . t)
+ ;; 57
+ ((or atom (not (integer 1 2))) . t)
+ ;; 58
+ ((or atom (not (member foo))) . t)
+ ;; 59
+ ((and symbol (not cons)) . symbol)
+ ;; 60
+ ((and symbol (not symbol)) . nil)
+ ;; 61
+ ((and atom (not symbol)) . atom)
+ ;; 62
+ ((and atom (not string)) . (or array sequence atom))
+ ;; 63 Conservative
+ ((and symbol (not (member foo))) . symbol)
+ ;; 64 Conservative
+ ((and symbol (not (member 3))) . symbol)
+ ;; 65
+ ((and (not (member foo)) (integer 1 10)) . (integer 1 10))
+ ;; 66
+ ((and (member foo) (not (integer 1 10))) . (member foo))
+ ;; 67
+ ((and t (not (member foo))) . (not (member foo)))
+ ;; 68
+ ((and integer (not (integer 3 4))) . (or (integer * 2) (integer 5 *)))
+ ;; 69
+ ((and (integer 0 20) (not (integer 5 10))) . (or (integer 0 4) (integer 11 20)))
+ ;; 70
+ ((and (not (member a)) (not (member b))) . (not (member b a)))
+ ;; 71
+ ((and (not boolean) (not (member b))) . (not (or (member b) boolean)))
+ ;; 72
+ ((and t (integer 1 1)) . (integer 1 1))
+ ;; 73
+ ((not (integer -1 5)) . (not (integer -1 5)))
+ ;; 74
+ ((and boolean (or number marker)) . nil)
+ ;; 75
+ ((and atom (or number marker)) . (or marker number))
+ ;; 76
+ ((and symbol (or number marker)) . nil)
+ ;; 77
+ ((and (or symbol string) (or number marker)) . nil)
+ ;; 78
+ ((and t t) . t)
+ ;; 80
+ ((and (or marker number) (integer 0 0)) . (integer 0 0))
+ ;; 81
+ ((and t (not t)) . nil)
+ ;; 82
+ ((or (integer 1 1) (not (integer 1 1))) . t))
+ "Alist type specifier -> expected type specifier."))
(defmacro comp-cstr-synthesize-tests ()
"Generate all tests from `comp-cstr-typespec-tests-alist'."
(eval func-form t)
(native-compile (cadr func-form))))
-(defconst comp-tests-type-spec-tests
- `(
- ;; 1
- ((defun comp-tests-ret-type-spec-f (x)
- x)
- t)
-
- ;; 2
- ((defun comp-tests-ret-type-spec-f ()
- 1)
- (integer 1 1))
-
- ;; 3
- ((defun comp-tests-ret-type-spec-f (x)
- (if x 1 3))
- (or (integer 1 1) (integer 3 3)))
-
- ;; 4
- ((defun comp-tests-ret-type-spec-f (x)
- (let (y)
+(cl-eval-when (compile eval load)
+ (defconst comp-tests-type-spec-tests
+ `(
+ ;; 1
+ ((defun comp-tests-ret-type-spec-f (x)
+ x)
+ t)
+
+ ;; 2
+ ((defun comp-tests-ret-type-spec-f ()
+ 1)
+ (integer 1 1))
+
+ ;; 3
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if x 1 3))
+ (or (integer 1 1) (integer 3 3)))
+
+ ;; 4
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (if x
+ (setf y 1)
+ (setf y 2))
+ y))
+ (integer 1 2))
+
+ ;; 5
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (if x
+ (setf y 1)
+ (setf y 3))
+ y))
+ (or (integer 1 1) (integer 3 3)))
+
+
+ ;; 6
+ ((defun comp-tests-ret-type-spec-f (x)
(if x
- (setf y 1)
- (setf y 2))
- y))
- (integer 1 2))
-
- ;; 5
- ((defun comp-tests-ret-type-spec-f (x)
- (let (y)
+ (list x)
+ 3))
+ (or cons (integer 3 3)))
+
+ ;; 7
+ ((defun comp-tests-ret-type-spec-f (x)
(if x
- (setf y 1)
- (setf y 3))
- y))
- (or (integer 1 1) (integer 3 3)))
-
-
- ;; 6
- ((defun comp-tests-ret-type-spec-f (x)
- (if x
- (list x)
- 3))
- (or cons (integer 3 3)))
-
- ;; 7
- ((defun comp-tests-ret-type-spec-f (x)
- (if x
- 'foo
- 3))
- (or (member foo) (integer 3 3)))
-
- ;; 8
- ((defun comp-tests-ret-type-spec-f (x)
- (if (eq x 3)
- x
- 'foo))
- (or (member foo) (integer 3 3)))
-
- ;; 9
- ((defun comp-tests-ret-type-spec-f (x)
- (if (eq 3 x)
- x
- 'foo))
- (or (member foo) (integer 3 3)))
-
- ;; 10
- ((defun comp-tests-ret-type-spec-f (x)
- (if (= x 3)
- x
- 'foo))
- (or (member foo) (integer 3 3)))
-
- ;; 11
- ((defun comp-tests-ret-type-spec-f (x)
- (if (= 3 x)
- x
- 'foo))
- (or (member foo) (integer 3 3)))
-
- ;; 12
- ((defun comp-tests-ret-type-spec-8-3-f (x)
- (if (= x 3)
- 'foo
- x))
- (or (member foo) marker number))
-
- ;; 13
- ((defun comp-tests-ret-type-spec-8-4-f (x y)
- (if (= x y)
- x
- 'foo))
- (or (member foo) marker number))
-
- ;; 14
- ((defun comp-tests-ret-type-spec-9-1-f (x)
- (comp-hint-fixnum x))
- (integer ,most-negative-fixnum ,most-positive-fixnum))
-
- ;; 15
- ((defun comp-tests-ret-type-spec-f (x)
- (comp-hint-cons x))
- cons)
-
- ;; 16
- ((defun comp-tests-ret-type-spec-f (x)
- (let (y)
- (when x
- (setf y 4))
- y))
- (or null (integer 4 4)))
-
- ;; 17
- ((defun comp-tests-ret-type-spec-f ()
- (let (x
- (y 3))
- (setf x y)
- y))
- (integer 3 3))
-
- ;; 18
- ((defun comp-tests-ret-type-spec-f (x)
- (let ((y 3))
- (when x
- (setf y x))
- y))
- t)
-
- ;; 19
- ((defun comp-tests-ret-type-spec-f (x y)
- (eq x y))
- boolean)))
-
-(defun comp-tests-define-type-spec-test (number x)
- `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
- ,(format "Type specifier test number %d." number)
- (let ((comp-ctxt (make-comp-cstr-ctxt)))
- (comp-tests-check-ret-type-spec ',(car x) ',(cadr x)))))
+ 'foo
+ 3))
+ (or (member foo) (integer 3 3)))
+
+ ;; 8
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eq x 3)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 9
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (eq 3 x)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 10
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 3)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 11
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= 3 x)
+ x
+ 'foo))
+ (or (member foo) (integer 3 3)))
+
+ ;; 12
+ ((defun comp-tests-ret-type-spec-f (x)
+ (if (= x 3)
+ 'foo
+ x))
+ (or (member foo) marker number))
+
+ ;; 13
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (if (= x y)
+ x
+ 'foo))
+ (or (member foo) marker number))
+
+ ;; 14
+ ((defun comp-tests-ret-type-spec-f (x)
+ (comp-hint-fixnum x))
+ (integer ,most-negative-fixnum ,most-positive-fixnum))
+
+ ;; 15
+ ((defun comp-tests-ret-type-spec-f (x)
+ (comp-hint-cons x))
+ cons)
+
+ ;; 16
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let (y)
+ (when x
+ (setf y 4))
+ y))
+ (or null (integer 4 4)))
+
+ ;; 17
+ ((defun comp-tests-ret-type-spec-f ()
+ (let (x
+ (y 3))
+ (setf x y)
+ y))
+ (integer 3 3))
+
+ ;; 18
+ ((defun comp-tests-ret-type-spec-f (x)
+ (let ((y 3))
+ (when x
+ (setf y x))
+ y))
+ t)
+
+ ;; 19
+ ((defun comp-tests-ret-type-spec-f (x y)
+ (eq x y))
+ boolean)))
+
+ (defun comp-tests-define-type-spec-test (number x)
+ `(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()
+ ,(format "Type specifier test number %d." number)
+ (let ((comp-ctxt (make-comp-cstr-ctxt)))
+ (comp-tests-check-ret-type-spec ',(car x) ',(cadr x))))))
(defmacro comp-tests-define-type-spec-tests ()
"Define all type specifier tests."