Unit tests for fl>= typechecking
This commit is contained in:
parent
1e890f18be
commit
df0f9d53bd
|
@ -47,7 +47,7 @@
|
|||
|
||||
(do-standard-inits)
|
||||
(print-complex-filters? #t)
|
||||
|
||||
|
||||
;; tr-expand: syntax? -> syntax?
|
||||
;; Expands out a form and annotates it with necesarry TR machinery.
|
||||
(define (tr-expand stx)
|
||||
|
@ -1130,10 +1130,10 @@
|
|||
(-polydots (z x y)
|
||||
(t:-> (cl->*
|
||||
((t:-> x z) (-pair x (-lst x)) . t:-> . (-pair z (-lst z)))
|
||||
((list ((list x) (y y) . ->... . z) (-lst x))
|
||||
((-lst y) y)
|
||||
((list ((list x) (y y) . ->... . z) (-lst x))
|
||||
((-lst y) y)
|
||||
. ->... . (-lst z)))
|
||||
: -true-filter
|
||||
: -true-filter
|
||||
: (-id-path #'map)))]
|
||||
|
||||
;; error tests
|
||||
|
@ -1293,7 +1293,7 @@
|
|||
'whatever))
|
||||
#:ret (ret (-val 'whatever) -true-filter)]
|
||||
[tc-e
|
||||
(call-with-values (lambda ()
|
||||
(call-with-values (lambda ()
|
||||
((inst time-apply Number Number Number Number Number Number Number)
|
||||
+ (list 1 2 3 4 5 6)))
|
||||
(lambda: ([v : (Listof Number)]
|
||||
|
@ -1764,7 +1764,7 @@
|
|||
#:ret (ret -Boolean -true-filter))
|
||||
(tc-e (let: ((e : Compiled-Expression (compile #'(module + racket 2))))
|
||||
(compiled-module-expression? e)) -Boolean)
|
||||
|
||||
|
||||
;Dynamic Require
|
||||
(tc-e (dynamic-require "module/path" #f) -Void)
|
||||
(tc-e (dynamic-require 'module/path #f) -Void)
|
||||
|
@ -2067,7 +2067,7 @@
|
|||
(: foo ((Sequenceof Integer) -> (Sequenceof Any)))
|
||||
(define foo
|
||||
(λ (x)
|
||||
(cond
|
||||
(cond
|
||||
[(boolean? x) (void)]
|
||||
[(symbol? x) (void)]
|
||||
[(char? x) (void)]
|
||||
|
@ -2141,7 +2141,7 @@
|
|||
((inst filter Any Symbol) symbol? null)
|
||||
(-lst -Symbol)]
|
||||
[tc-e/t (ann (plambda: (A -Boolean ...) ((a : A) b : B ... B)
|
||||
(apply (inst values A B ... B) a b))
|
||||
(apply (inst values A B ... B) a b))
|
||||
(All (A B ...) (A B ... -> (values A B ... B))))
|
||||
(-polydots (a b) ((list a) (b b) . ->... . (make-ValuesDots (list (-result a)) b 'b)))]
|
||||
[tc-e/t (ann (ann 'x Symbol) Symbol) -Symbol]
|
||||
|
@ -2406,12 +2406,12 @@
|
|||
(place-channel-put c1 "a"))
|
||||
-Void]
|
||||
[tc-e (place-message-allowed? 'msg) -Boolean]
|
||||
|
||||
|
||||
[tc-e (let ()
|
||||
(: bar ((Evtof Any) -> (Evtof Any)))
|
||||
(define bar
|
||||
(λ (x)
|
||||
(cond
|
||||
(cond
|
||||
[(boolean? x) "nope"]
|
||||
[(symbol? x) "nope"]
|
||||
[(char? x) "nope"]
|
||||
|
@ -3180,26 +3180,26 @@
|
|||
|
||||
|
||||
[tc-e
|
||||
(tr:lambda xs (tr:lambda (x)
|
||||
(tr:lambda xs (tr:lambda (x)
|
||||
(apply values (map (tr:lambda (z) (tr:lambda (y) (symbol? x))) xs))))
|
||||
#:ret
|
||||
(ret (-polydots (a ...)
|
||||
(->... (list) (a a)
|
||||
(-values (list
|
||||
(t:-> Univ
|
||||
(-values-dots
|
||||
(-values-dots
|
||||
(list)
|
||||
(t:-> Univ -Boolean
|
||||
(t:-> Univ -Boolean
|
||||
: (-FS (-filter -Symbol (list 1 0)) -top)) 'a)))))))
|
||||
#:expected
|
||||
(ret (-polydots (a ...)
|
||||
(->...
|
||||
(list) (a a)
|
||||
(-values
|
||||
(->...
|
||||
(list) (a a)
|
||||
(-values
|
||||
(list
|
||||
(t:-> Univ
|
||||
(-values-dots
|
||||
(list)
|
||||
(t:-> Univ
|
||||
(-values-dots
|
||||
(list)
|
||||
(t:-> Univ -Boolean : (-FS (-filter -Symbol (list 1 0)) -top)) 'a)))))))]
|
||||
|
||||
[tc-err
|
||||
|
@ -3209,7 +3209,7 @@
|
|||
(lambda xs (inst (apply values (plambda: (b) ([x : b]) x) xs) Symbol))
|
||||
#:ret (ret (-polydots (a ...) (->... (list) (a a)
|
||||
(-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))
|
||||
#:expected (ret (-polydots (a ...)
|
||||
#:expected (ret (-polydots (a ...)
|
||||
(->... (list) (a a)
|
||||
(-values-dots (list (t:-> -Symbol -Symbol)) a 'a))))]
|
||||
|
||||
|
@ -3401,10 +3401,10 @@
|
|||
(raise 'foo))
|
||||
#:ret (ret -String)
|
||||
#:msg #rx"expected: Symbol.*given: Any"]
|
||||
|
||||
|
||||
[tc-err
|
||||
(raise (λ ([x : Number]) (add1 x)))]
|
||||
|
||||
|
||||
[tc-err
|
||||
(raise (exn:fail:syntax "" (current-continuation-marks)
|
||||
(list (datum->syntax #f add1))))]
|
||||
|
@ -3452,7 +3452,7 @@
|
|||
[tc-e ((letrec ((loop (lambda: ([x : (Listof Integer)]) (cond ((null? (cdr x)) #t) (else #f))))) loop)
|
||||
(list 1 2))
|
||||
-Boolean]
|
||||
|
||||
|
||||
;; bottom propogation from cons
|
||||
[tc-e (let ()
|
||||
(: f ((U (Listof Number) (Listof String)) -> (Listof Number)))
|
||||
|
@ -3462,11 +3462,11 @@
|
|||
[else (map string-length l)])))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
;; aliasing unit tests
|
||||
[tc-e (let ()
|
||||
(: foo (-> Any Number))
|
||||
(define foo
|
||||
(define foo
|
||||
(λ (x)
|
||||
(let ([y x])
|
||||
(if (number? y)
|
||||
|
@ -3474,7 +3474,7 @@
|
|||
42))))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
[tc-e (let ()
|
||||
(: foo (-> Any Number))
|
||||
(define foo
|
||||
|
@ -3482,14 +3482,14 @@
|
|||
(match x
|
||||
[(? number?) x]
|
||||
[`(_ . (_ . ,(? number?))) (cddr x)]
|
||||
[`(_ . (_ . ,(? pair? p)))
|
||||
[`(_ . (_ . ,(? pair? p)))
|
||||
(if (number? (caddr x))
|
||||
(car p)
|
||||
41)]
|
||||
[_ 42])))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
[tc-err (let ()
|
||||
(: foo (-> Any Number))
|
||||
(define foo
|
||||
|
@ -3499,7 +3499,7 @@
|
|||
(if (number? x)
|
||||
x*
|
||||
42))))))]
|
||||
|
||||
|
||||
;; ensure let-aliasing doesn't cause problems w/ type variable types
|
||||
[tc-e (let ()
|
||||
(: foo (All (A) (-> A (Tuple Number A))))
|
||||
|
@ -3512,7 +3512,7 @@
|
|||
[else (list 42 x*)]))))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
;; tests looking up path-types into unions
|
||||
[tc-e (let ()
|
||||
(: foo ((U (Pairof Number Number) (Pairof Number String)) -> Number))
|
||||
|
@ -3521,7 +3521,7 @@
|
|||
x)))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
;; tests looking up path-types into polymorphic functions
|
||||
[tc-e (let ()
|
||||
(: poly-foo (All (α β) (U (Pairof Number α) (Pairof Number β)) -> Number))
|
||||
|
@ -3529,7 +3529,7 @@
|
|||
x)))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
[tc-e (let ()
|
||||
(: poly-foo (All (α β) ((U (Pairof Number α) (Pairof Number β)) -> (U α β))))
|
||||
(define poly-foo (λ (p)
|
||||
|
@ -3537,7 +3537,7 @@
|
|||
x)))
|
||||
(void))
|
||||
-Void]
|
||||
|
||||
|
||||
[tc-e (let ()
|
||||
(: poly-foo-dots (All (α ... β) (U (Pairof Number α) (Pairof Number β)) -> Number))
|
||||
(define poly-foo-dots (λ (p)
|
||||
|
@ -3633,6 +3633,114 @@
|
|||
[tc-e/t ((inst values Any) "a") -String]
|
||||
[tc-e ((inst second Any Any Any) (list "a" "b")) -String]
|
||||
[tc-e/t (abs 4) -PosByte]
|
||||
|
||||
;; PR 124: Tests for flonum typechecking
|
||||
[tc-e
|
||||
(ann (let ([x : Flonum-Zero 0.0])
|
||||
(if (fl>= x (ann -4.0 Flonum))
|
||||
x -3.0)) Flonum)
|
||||
-Fl]
|
||||
[tc-e
|
||||
(ann (let ([x : Flonum-Zero 0.0])
|
||||
(if (fl<= x (ann -4.0 Flonum))
|
||||
-3.0 x)) Flonum)
|
||||
-Fl]
|
||||
|
||||
;; -PosFl -Fl
|
||||
[tc-e
|
||||
(ann (let ([x : Positive-Flonum 5.0])
|
||||
(if (fl>= x (ann 1.0 Flonum))
|
||||
x 1.0)) Flonum)
|
||||
-Fl]
|
||||
[tc-e
|
||||
(ann (let ([x : Positive-Flonum 5.0])
|
||||
(if (fl<= x (ann 1.0 Flonum))
|
||||
1.0 x)) Flonum)
|
||||
-Fl]
|
||||
|
||||
;; -NonNegFl -Fl
|
||||
[tc-e
|
||||
(ann
|
||||
(let ([x : Nonnegative-Flonum 5.0])
|
||||
(if (fl>= x (ann 1.0 Flonum))
|
||||
x 1.0)) Flonum)
|
||||
-Fl]
|
||||
[tc-e
|
||||
(ann (let ([x : Nonnegative-Flonum 5.0])
|
||||
(if (fl<= x (ann 1.0 Flonum))
|
||||
1.0 x)) Flonum)
|
||||
-Fl]
|
||||
|
||||
;; -NonPosFl -Fl
|
||||
[tc-e
|
||||
(ann (let ([x : Nonpositive-Flonum -1.0])
|
||||
(if (fl>= x (ann -5.0 Flonum))
|
||||
x -2.0)) Flonum)
|
||||
-Fl]
|
||||
[tc-e
|
||||
(ann (let ([x : Nonpositive-Flonum -1.0])
|
||||
(if (fl<= x (ann -5.0 Flonum))
|
||||
-2.0 x)) Flonum)
|
||||
-Fl]
|
||||
|
||||
;; -NegFl -Fl
|
||||
[tc-e
|
||||
(ann (let ([x : Negative-Flonum -1.0])
|
||||
(if (fl>= x (ann -5.0 Flonum))
|
||||
x -2.0)) Flonum)
|
||||
-Fl]
|
||||
[tc-e
|
||||
(ann (let ([x : Negative-Flonum -1.0])
|
||||
(if (fl<= x (ann -5.0 Flonum))
|
||||
-2.0 x)) Flonum)
|
||||
-Fl]
|
||||
|
||||
;; Error tests
|
||||
;; Flonum, Flonum-Zero
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl>= x (ann 0.0 Flonum-Zero))
|
||||
x 0.0)) Flonum-Zero)]
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl<= x (ann 0.0 Flonum-Zero))
|
||||
0.0 x)) Flonum-Zero)]
|
||||
;; Flonum, Positive-Flownum
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl>= x (ann 1.0 Positive-Flonum))
|
||||
x 1.0)) Positive-Flonum)]
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl<= x (ann 1.0 Positive-Flonum))
|
||||
1.0 x)) Positive-Flonum)]
|
||||
;; Flonum, Nonnegative-Flonum
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl>= x (ann 1.0 Nonnegative-Flonum))
|
||||
x 1.0)) Nonnegative-Flonum)]
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl<= x (ann 1.0 Nonnegative-Flonum))
|
||||
1.0 x)) Nonnegative-Flonum)]
|
||||
;;Flonum, Negative-Flonum
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum -1.0])
|
||||
(if (fl>= x (ann -5.0 Negative-Flonum))
|
||||
x -2.0)) Negative-Flonum)]
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum -1.0])
|
||||
(if (fl<= x (ann -5.0 Negative-Flonum))
|
||||
-2.0 x)) Negative-Flonum)]
|
||||
;; Flonum, Nonpositive-Flonum
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl>= x (ann -4.0 Nonpositive-Flonum))
|
||||
x -3.0)) Nonpositive-Flonum)]
|
||||
[tc-err
|
||||
(ann (let ([x : Flonum 5.0])
|
||||
(if (fl<= x (ann -4.0 Nonpositive-Flonum))
|
||||
-3.0 x)))]
|
||||
)
|
||||
|
||||
(test-suite
|
||||
|
|
Loading…
Reference in New Issue
Block a user