From 38e0297b074f5265f2acae112644d920982b493b Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Sat, 3 May 2008 00:03:43 +0000 Subject: [PATCH] New test for multi-arg andmap. Fix more things to be Integer. Finally fix parse-type tests. svn: r9615 --- collects/tests/typed-scheme/succeed/andmap.ss | 3 +++ .../unit-tests/parse-type-tests.ss | 26 +++++++++++++++---- .../unit-tests/typecheck-tests.ss | 8 +++--- 3 files changed, 28 insertions(+), 9 deletions(-) create mode 100644 collects/tests/typed-scheme/succeed/andmap.ss diff --git a/collects/tests/typed-scheme/succeed/andmap.ss b/collects/tests/typed-scheme/succeed/andmap.ss new file mode 100644 index 0000000000..c1c40d3cc6 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/andmap.ss @@ -0,0 +1,3 @@ +#lang typed-scheme + +(andmap = (list 1 2 3) (list 1 2 3)) diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss b/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss index 748603c47d..cf8d06446f 100644 --- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss @@ -1,7 +1,7 @@ #lang scheme/base (require "test-utils.ss" (for-syntax scheme/base)) (require (private planet-requires type-comparison parse-type type-rep - tc-utils type-environments type-alias-env + tc-utils type-environments type-alias-env subtype type-name-env init-envs union type-utils)) (require (rename-in (private type-effect-convenience) [-> t:->]) @@ -12,6 +12,22 @@ (provide parse-type-tests) +;; HORRIBLE HACK! +;; We are solving the following problem: +;; when we require "base-env.ss" for template, it constructs the type-alias-env +;; in phase 0 (relative to this module), but populates it with phase -1 identifiers +;; The identifiers are also bound in this module at phase -1, but the comparison for +;; the table is phase 0, so they don't compare correctly + +;; The solution is to add the identifiers to the table at phase 0. +;; We do this by going through the table, constructing new identifiers based on the symbol of the old identifier. +;; This relies on the identifiers being bound at phase 0 in this module (which they are, because we have a +;; phase 0 require of "base-env.ss"). +(for ([pr (type-alias-env-map cons)]) + (let ([nm (car pr)] + [ty (cdr pr)]) + (register-resolved-type-alias (datum->syntax #'here (syntax->datum nm)) ty))) + (define-syntax (run-one stx) (syntax-case stx () [(_ ty) (syntax/loc stx @@ -55,10 +71,10 @@ [(Number Number Number Boolean -> Number) (N N N B . t:-> . N)] [(Number Number Number .. -> Boolean) ((list N N) N . ->* . B)] ;[((. Number) -> Number) (->* (list) N N)] ;; not legal syntax - [(Un Number Boolean) (Un N B)] - [(Un Number Boolean Number) (Un N B)] - [(Un Number Boolean 1) (Un N B)] - [(All (a) (list-of a)) (-poly (a) (make-Listof a))] + [(U Number Boolean) (Un N B)] + [(U Number Boolean Number) (Un N B)] + [(U Number Boolean 1) (Un N B)] + [(All (a) (Listof a)) (-poly (a) (make-Listof a))] [(case-lambda (Number -> Boolean) (Number Number -> Number)) (cl-> [(N) B] [(N N) N])] [1 (-val 1)] diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss index 47a81f7e59..8aef448c6c 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss @@ -88,7 +88,7 @@ (tc-e 3 -Integer) (tc-e "foo" -String) - (tc-e (+ 3 4) N) + (tc-e (+ 3 4) -Integer) [tc-e (lambda: () 3) (-> -Integer)] [tc-e (lambda: ([x : Number]) 3) (-> N -Integer)] [tc-e (lambda: ([x : Number] [y : Boolean]) 3) (-> N B -Integer)] @@ -110,7 +110,7 @@ (make-Poly '(a) (-> (make-Listof (-v a)) (-v a)))] [tc-e (case-lambda: [([a : Number] [b : Number]) (+ a b)]) (-> N N N)] [tc-e (let: ([x : Number 5]) x) N (-vet #'x) (-vef #'x)] - [tc-e (let-values ([(x) 4]) (+ x 1)) N] + [tc-e (let-values ([(x) 4]) (+ x 1)) -Integer] [tc-e (let-values ([(#{x : Number} #{y : Boolean}) (values 3 #t)]) (and (= x 1) (not y))) B (list (-rest (-val #f) #'y)) (list)] [tc-e (values 3) -Integer] @@ -135,7 +135,7 @@ [tc-e (let: ([f : (Number Number -> Number) +]) (f 3 4)) N] [tc-e (let: ([+ : (Boolean -> Number) (lambda: ([x : Boolean]) 3)]) (+ #f)) N] [tc-e (when #f #t) (Un -Void)] - [tc-e (when (number? #f) (+ 4 5)) (Un N -Void)] + [tc-e (when (number? #f) (+ 4 5)) (Un -Integer -Void)] [tc-e (let: ([x : (Un #f Number) 7]) (if x (+ x 1) 3)) N] @@ -502,7 +502,7 @@ (define y 2) (define z (+ x y)) (* x z)) - N] + -Integer] [tc-e (let () (define: (f [x : Number]) : Number