(defconst comp-cstr-typespec-tests-alist
`((symbol . symbol)
((or string array) . array)
- ;; ((and string array) . string)
((or symbol number) . (or symbol number))
((or cons atom) . (or cons atom)) ;; SBCL return T
+ ((or integer number) . number)
+ ((or (or integer symbol) number) . (or symbol number))
+ ((or (or integer symbol) (or number list)) . (or list symbol number))
+ ((or (or integer number) nil) . number)
+ ;; ((and string array) . string)
;; ((and cons atom) . (or cons atom))
+ ;; ((and (member foo) (member bar)) . symbol)
+ ;; ((and (member foo) symbol) . (member foo))
((member foo) . (member foo))
((member foo bar) . (member foo bar))
((or (member foo) (member bar)) . (member foo bar))
- ;; ((and (member foo) (member bar)) . symbol)
((or (member foo) symbol) . symbol) ;; SBCL return (OR SYMBOL (MEMBER FOO))
- ;; ((and (member foo) symbol) . (member foo))
- ((or (member foo) number) . (or (member foo) number)))
+ ((or (member foo) number) . (or (member foo) number))
+ ((integer 1 2) . (integer 1 2))
+ ((or (integer -1 0) (integer 3 4)) . (or (integer -1 0) (integer 3 4)))
+ ((or (integer -1 2) (integer 3 4)) . (integer -1 4))
+ ((or (integer -1 3) (integer 3 4)) . (integer -1 4))
+ ((or (integer -1 4) (integer 3 4)) . (integer -1 4))
+ ((or (integer -1 5) (integer 3 4)) . (integer -1 5))
+ ((or (integer -1 *) (integer 3 4)) . (integer -1 *))
+ ((or (integer -1 2) (integer * 4)) . (integer * 4)))
"Alist type specifier -> expected type specifier.")
(defmacro comp-cstr-synthesize-tests ()
;; Range propagation tests. ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(comp-deftest range-simple-union ()
- (should (equal (comp-range-union '((-1 . 0)) '((3 . 4)))
- '((-1 . 0) (3 . 4))))
- (should (equal (comp-range-union '((-1 . 2)) '((3 . 4)))
- '((-1 . 4))))
- (should (equal (comp-range-union '((-1 . 3)) '((3 . 4)))
- '((-1 . 4))))
- (should (equal (comp-range-union '((-1 . 4)) '((3 . 4)))
- '((-1 . 4))))
- (should (equal (comp-range-union '((-1 . 5)) '((3 . 4)))
- '((-1 . 5))))
- (should (equal (comp-range-union '((-1 . 0)) '())
- '((-1 . 0)))))
-
+;; FIXME to be removed when movable into comp-cstr-tests.el
(comp-deftest range-simple-intersection ()
(should (equal (comp-range-intersection '((-1 . 0)) '((3 . 4)))
'()))
(should (equal (comp-range-intersection '((-1 . 0)) '())
'())))
-(comp-deftest union-types ()
- (let ((comp-ctxt (make-comp-ctxt)))
- (should (equal (comp-union-typesets '(integer) '(number))
- '(number)))
- (should (equal (comp-union-typesets '(integer symbol) '(number))
- '(symbol number)))
- (should (equal (comp-union-typesets '(integer symbol) '(number list))
- '(list symbol number)))
- (should (equal (comp-union-typesets '(integer symbol) '())
- '(symbol integer)))))
-
-(comp-deftest destructure-type-spec ()
- (should (equal (comp-type-spec-to-constraint 'symbol)
- (make-comp-constraint :typeset '(symbol))))
- (should (equal (comp-type-spec-to-constraint '(or symbol number))
- (make-comp-constraint :typeset '(number symbol))))
- (should-error (comp-type-spec-to-constraint '(symbol number)))
- (should (equal (comp-type-spec-to-constraint '(member foo bar))
- (make-comp-constraint :typeset nil :valset '(foo bar))))
- (should (equal (comp-type-spec-to-constraint '(integer 1 2))
- (make-comp-constraint :typeset nil :range '((1 . 2)))))
- (should (equal (comp-type-spec-to-constraint '(or (integer 1 2) (integer 4 5)))
- (make-comp-constraint :typeset nil :range '((4 . 5) (1 . 2)))))
- (should (equal (comp-type-spec-to-constraint '(integer * 2))
- (make-comp-constraint :typeset nil :range '((- . 2)))))
- (should (equal (comp-type-spec-to-constraint '(integer 1 *))
- (make-comp-constraint :typeset nil :range '((1 . +)))))
- (should (equal (comp-type-spec-to-constraint '(integer * *))
- (make-comp-constraint :typeset nil :range '((- . +)))))
- (should (equal (comp-type-spec-to-constraint '(or (integer 1 2)
- (member foo bar)))
- (make-comp-constraint :typeset nil
- :valset '(foo bar)
- :range '((1 . 2)))))
- (should (equal (comp-type-spec-to-constraint
- '(function (t t) cons))
- (make-comp-constraint-f
- :args `(,(make-comp-constraint :typeset '(t))
- ,(make-comp-constraint :typeset '(t)))
- :ret (make-comp-constraint :typeset '(cons)))))
- (should (equal (comp-type-spec-to-constraint
- '(function ((or integer symbol)) float))
- (make-comp-constraint-f
- :args `(,(make-comp-constraint :typeset '(symbol integer)))
- :ret (make-comp-constraint :typeset '(float))))))
-
;;; comp-tests.el ends here