Re-enabled tests in type-expander.lp2.rkt, and fixed check-equal?:, which was ignoring the : Type.

This commit is contained in:
Georges Dupéron 2016-01-16 00:53:43 +01:00
parent 63e8d17f53
commit 4dd0a08dbf
2 changed files with 22 additions and 24 deletions

View File

@ -249,7 +249,8 @@
(make-check-expression '#,(syntax->datum stx))) (make-check-expression '#,(syntax->datum stx)))
(λ () (λ ()
(untyped:check-true (untyped:check-true
(equal? actual expected)))))) (equal? (?? (ann actual type) actual)
expected))))))
(define-syntax/parse (define-syntax/parse
(check-not-equal?: actual (check-not-equal?: actual
@ -270,7 +271,8 @@
(make-check-expression '#,(syntax->datum stx))) (make-check-expression '#,(syntax->datum stx)))
(λ () (λ ()
(untyped:check-true (untyped:check-true
(not (equal? actual expected)))))))) (not (equal? (?? (ann actual type) actual)
expected))))))))
(require/provide 'my-typed-rackunit) (require/provide 'my-typed-rackunit)

View File

@ -619,21 +619,21 @@ them.
racket-6.4.0.1-i386-linux-precise.sh)) racket-6.4.0.1-i386-linux-precise.sh))
#| #|
(define-struct/exec se0 () (define-struct/exec se0 ()
;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
[(λ (self v) (cons self v)) : ( se0 Any (Pairof se0 Any))]) [(λ (self v) (cons self v)) : ( se0 Any (Pairof se0 Any))])
(define-struct/exec se1 ([x : Number]) (define-struct/exec se1 ([x : Number])
;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))]) ;[(λ (self v) (cons self v)) : (∀ (A) (→ se0 A (Pairof se0 A)))])
[(λ (self v) (cons self v)) : ( se1 Any (Pairof se1 Any))]) [(λ (self v) (cons self v)) : ( se1 Any (Pairof se1 Any))])
(define-struct/exec se2 ([x : Number] [y : Number]) (define-struct/exec se2 ([x : Number] [y : Number])
[(λ (self v) (cons self v)) : ( se2 Any (Pairof se2 Any))]) [(λ (self v) (cons self v)) : ( se2 Any (Pairof se2 Any))])
(define-struct/exec (se3 se2) ([z : String]) (define-struct/exec (se3 se2) ([z : String])
[(λ (self v w) (list self v w)) [(λ (self v w) (list self v w))
;: (∀ (A B) (→ se3 A B (List se2 A B)))]) ;: (∀ (A B) (→ se3 A B (List se2 A B)))])
: ( se3 Any Any (List se2 Any Any))]) : ( se3 Any Any (List se2 Any Any))])
(define-struct/exec (se4 se2) ([z : String]) (define-struct/exec (se4 se2) ([z : String])
[(λ (self v w) (list self v w)) [(λ (self v w) (list self v w))
;: (∀ (A B) (→ se4 A B (List se2 A B)))]) ;: (∀ (A B) (→ se4 A B (List se2 A B)))])
: ( se4 Any ( Number Number) (List se2 Any ( Number Number)))]) : ( se4 Any ( Number Number) (List se2 Any ( Number Number)))])
(check (λ (a b) (not (equal? a b))) (se0) (se0)) (check (λ (a b) (not (equal? a b))) (se0) (se0))
(check-equal?: (cdr ((se0) 'a)) 'a) (check-equal?: (cdr ((se0) 'a)) 'a)
@ -663,14 +663,14 @@ them.
(check-equal?: (se2-x (car ((se3 4 5 "f") 'd 'e))) 4) (check-equal?: (se2-x (car ((se3 4 5 "f") 'd 'e))) 4)
(check-equal?: (se2-y (car ((se3 4 5 "f") 'd 'e))) 5) (check-equal?: (se2-y (car ((se3 4 5 "f") 'd 'e))) 5)
(check-equal?: (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))]) (check-equal?: (let ([ret : Any (car ((se3 4 5 "f") 'd 'e))])
(if (se3? ret) (if (se3? ret)
(se3-z ret) (se3-z ret)
"wrong type!")) "wrong type!"))
"f") "f")
(check-equal?: (cadr ((se3 4 5 "f") 'd 'e)) 'd) (check-equal?: (cadr ((se3 4 5 "f") 'd 'e)) 'd)
(check-equal?: (caddr ((se3 4 5 "f") 'd 'e)) 'e) (check-equal?: (caddr ((se3 4 5 "f") 'd 'e)) 'e)
(check-equal?: ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12) (check-equal?: ((caddr ((se4 4 5 "f") 'd (λ ([x : Number]) (* x 2)))) 12)
24) 24)
(check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2))) (check-not-exn (λ () (ann (car ((se3 4 5 "f") 'd 'e)) se2)))
(check-true (se2? (car ((se3 4 5 "f") 'd 'e)))) (check-true (se2? (car ((se3 4 5 "f") 'd 'e))))
(check-true (se3? (car ((se3 4 5 "f") 'd 'e)))) (check-true (se3? (car ((se3 4 5 "f") 'd 'e))))
@ -1084,22 +1084,18 @@ And, last but not least, we will add a @tc[test] module.
<test-expand-type> <test-expand-type>
#|
<test-:> <test-:>
<test-define-type> <test-define-type>
<test-define> <test-define>
<test-lambda> <test-lambda>
|# <test-struct>
;<test-struct>
<test-define-struct/exec> <test-define-struct/exec>
#|
<test-ann> <test-ann>
<test-inst> <test-inst>
<test-let> <test-let>
<test-let*> <test-let*>
<test-let-values> <test-let-values>
<test-make-predicate> <test-make-predicate>)]
|#)]
We can now assemble the modules in this order: We can now assemble the modules in this order: