From 15f6c532e684d56ca0699b9c7983480e8528119b Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Tue, 10 Jun 2008 16:40:05 -0400 Subject: [PATCH] Changes to tests for ... original commit: 4ae41412579f7c6daa1d2b527897a50d4f098ea7 --- .../tests/typed-scheme/succeed/inst-dots.ss | 7 ++++++ .../tests/typed-scheme/succeed/metrics.ss | 4 ++-- .../typed-scheme/succeed/poly-subtype.ss | 20 ++++++++++++++++ .../tests/typed-scheme/succeed/random-bits.ss | 4 ++-- .../typed-scheme/succeed/varargs-tests.ss | 4 ++-- .../typed-scheme/unit-tests/all-tests.ss | 5 +++- .../typed-scheme/unit-tests/infer-tests.ss | 4 +++- .../unit-tests/parse-type-tests.ss | 2 +- .../unit-tests/remove-intersect-tests.ss | 2 +- .../typed-scheme/unit-tests/subst-tests.ss | 23 +++++++++++++++++++ .../typed-scheme/unit-tests/subtype-tests.ss | 2 +- 11 files changed, 66 insertions(+), 11 deletions(-) create mode 100644 collects/tests/typed-scheme/succeed/inst-dots.ss create mode 100644 collects/tests/typed-scheme/succeed/poly-subtype.ss create mode 100644 collects/tests/typed-scheme/unit-tests/subst-tests.ss diff --git a/collects/tests/typed-scheme/succeed/inst-dots.ss b/collects/tests/typed-scheme/succeed/inst-dots.ss new file mode 100644 index 00000000..9e3f138b --- /dev/null +++ b/collects/tests/typed-scheme/succeed/inst-dots.ss @@ -0,0 +1,7 @@ +#lang typed-scheme + +(require typed-scheme/private/extra-procs) + +((inst map* Number Number Number Number Number Number Number) + + + (list 1 2 3) (list 2 3 4) (list 1 2 3) (list 2 3 4) (list 1 2 3) (list 2 3 4)) diff --git a/collects/tests/typed-scheme/succeed/metrics.ss b/collects/tests/typed-scheme/succeed/metrics.ss index 150261ab..f5d49d8a 100644 --- a/collects/tests/typed-scheme/succeed/metrics.ss +++ b/collects/tests/typed-scheme/succeed/metrics.ss @@ -14,9 +14,9 @@ (require/typed filename-extension (Path -> (U #f Bytes)) (lib "file.ss")) (require/typed normalize-path (Path Path -> Path) (lib "file.ss")) (require/typed explode-path (Path -> (Listof Path)) (lib "file.ss")) -(require/typed srfi48::format (Port String String top .. -> top) "patch.ss") +(require/typed srfi48::format (Port String String top * -> top) "patch.ss") ;; FIXME - prefix -#;(require/typed srfi48:format ( Port String String top .. -> top) (prefix-in srfi48: (lib "48.ss" "srfi"))) +#;(require/typed srfi48:format ( Port String String top * -> top) (prefix-in srfi48: (lib "48.ss" "srfi"))) (require (lib "match.ss") ;(lib "file.ss") ;(lib "list.ss") diff --git a/collects/tests/typed-scheme/succeed/poly-subtype.ss b/collects/tests/typed-scheme/succeed/poly-subtype.ss new file mode 100644 index 00000000..39288d79 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/poly-subtype.ss @@ -0,0 +1,20 @@ +#lang typed-scheme + +(: f (All (a) (a -> a))) +(define (f x) x) + +(define: x : (Number -> Number) f) + +#; +((lambda: ([f : (All (a ...) (a ... a -> Number))]) 12) + +) + +#;(Lambda (a ...) + ((lambda: ([f : (a .. a -> Number)]) 12) +)) + +#| +(: g (All (a ...) ((a ... a -> Number) -> Number))) + +(define (g x) 3) + +|# \ No newline at end of file diff --git a/collects/tests/typed-scheme/succeed/random-bits.ss b/collects/tests/typed-scheme/succeed/random-bits.ss index 094cb2f4..f926e07f 100644 --- a/collects/tests/typed-scheme/succeed/random-bits.ss +++ b/collects/tests/typed-scheme/succeed/random-bits.ss @@ -38,7 +38,7 @@ [randomize! : ( -> Void)] [pseudo-randomize! : (Integer Integer -> Void)] [make-integers : (-> (Integer -> Integer)) ] - [make-reals : ( Nb .. -> ( -> Number))])) + [make-reals : ( Nb * -> ( -> Number))])) (define-type-alias Random :random-source) (define: (:random-source-make [state-ref : ( -> SpList)] @@ -46,7 +46,7 @@ [randomize! : ( -> Void)] [pseudo-randomize! : (Integer Integer -> Void)] [make-integers : (-> (Integer -> Integer)) ] - [make-reals : (Nb .. -> (-> Number))]) + [make-reals : (Nb * -> (-> Number))]) : Random (make-:random-source state-ref state-set! randomize! pseudo-randomize! make-integers make-reals )) diff --git a/collects/tests/typed-scheme/succeed/varargs-tests.ss b/collects/tests/typed-scheme/succeed/varargs-tests.ss index 0ebacce8..2bb528aa 100644 --- a/collects/tests/typed-scheme/succeed/varargs-tests.ss +++ b/collects/tests/typed-scheme/succeed/varargs-tests.ss @@ -17,11 +17,11 @@ (apply + '(2 3 4)) -(define: f : (number boolean .. -> number) +(define: f : (number boolean * -> number) (lambda: ([x : number] . [y : boolean]) (if (and (pair? y) (car y)) x (- x)))) -(define: f-cl : (number boolean .. -> number) +(define: f-cl : (number boolean * -> number) (case-lambda: [([x : number] . [y : boolean]) (if (and (pair? y) (car y)) x (- x))])) diff --git a/collects/tests/typed-scheme/unit-tests/all-tests.ss b/collects/tests/typed-scheme/unit-tests/all-tests.ss index 2e069f7f..aca0a4d1 100644 --- a/collects/tests/typed-scheme/unit-tests/all-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/all-tests.ss @@ -9,14 +9,17 @@ "parse-type-tests.ss" ;; done "type-annotation-test.ss" ;; done "module-tests.ss" + "subst-tests.ss" "infer-tests.ss") -(require (private planet-requires)) +(require (private planet-requires infer infer-dummy)) (require (schemeunit)) (provide unit-tests) +(infer-param infer) + (define unit-tests (apply test-suite diff --git a/collects/tests/typed-scheme/unit-tests/infer-tests.ss b/collects/tests/typed-scheme/unit-tests/infer-tests.ss index 27726a74..9dc58305 100644 --- a/collects/tests/typed-scheme/unit-tests/infer-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/infer-tests.ss @@ -1,6 +1,6 @@ #lang scheme/base (require "test-utils.ss" (for-syntax scheme/base)) -(require (private planet-requires type-effect-convenience type-rep unify union infer-ops type-utils) +(require (private planet-requires type-effect-convenience type-rep unify union infer type-utils) (prefix-in table: (private tables))) (require (schemeunit)) @@ -25,6 +25,8 @@ [fv-t (-poly (b c d e) (-v a)) a] [fv-t (-mu a (-lst a))] [fv-t (-mu a (-lst (-pair a (-v b)))) b] + + [fv-t (->* null (-v a) N) a] ;; check that a is CONTRAVARIANT )) (define-syntax-rule (i2-t t1 t2 (a b) ...) 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 cf8d0644..ded0c48f 100644 --- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.ss @@ -69,7 +69,7 @@ [(Number -> Number) (t:-> N N)] [(Number -> Number) (t:-> N N)] [(Number Number Number Boolean -> Number) (N N N B . t:-> . N)] - [(Number Number Number .. -> Boolean) ((list N N) N . ->* . B)] + [(Number Number Number * -> Boolean) ((list N N) N . ->* . B)] ;[((. Number) -> Number) (->* (list) N N)] ;; not legal syntax [(U Number Boolean) (Un N B)] [(U Number Boolean Number) (Un N B)] diff --git a/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss b/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss index ea874f36..ca83402b 100644 --- a/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss @@ -1,6 +1,6 @@ #lang scheme/base (require "test-utils.ss" (for-syntax scheme/base)) -(require (private type-rep type-effect-convenience planet-requires remove-intersect unify subtype union infer-ops)) +(require (private type-rep type-effect-convenience planet-requires remove-intersect subtype union infer)) (require (schemeunit)) diff --git a/collects/tests/typed-scheme/unit-tests/subst-tests.ss b/collects/tests/typed-scheme/unit-tests/subst-tests.ss new file mode 100644 index 00000000..6c89d4ef --- /dev/null +++ b/collects/tests/typed-scheme/unit-tests/subst-tests.ss @@ -0,0 +1,23 @@ +#lang scheme/base + +(require "test-utils.ss" (for-syntax scheme/base)) +(require (private planet-requires type-utils type-effect-convenience type-rep)) +(require (schemeunit)) + +(define-syntax-rule (s img var tgt result) + (test-eq? "test" (substitute img 'var tgt) result)) + +(define-syntax-rule (s... imgs var tgt result) + (test-eq? "test" (substitute-dots (list . imgs) 'var tgt) result)) + +(define (subst-tests) + (test-suite "Tests for substitution" + (s N a (-v a) N) + (s... (N B) a (make-Function (list (make-arr-dots null N (-v a) 'a))) (N B . -> . N)) + (s... (N B) a (make-Function (list (make-arr-dots (list -String) N (-v a) 'a))) (-String N B . -> . N)) + (s... (N B) a (make-Function (list (make-arr-dots (list -String) N (-v b) 'a))) (-String (-v b) (-v b) . -> . N)) + (s... (N B) a (make-Function (list (make-arr-dots (list -String) N (-v b) 'b))) + (make-Function (list (make-arr-dots (list -String) N (-v b) 'b)))))) + +(define-go subst-tests) + diff --git a/collects/tests/typed-scheme/unit-tests/subtype-tests.ss b/collects/tests/typed-scheme/unit-tests/subtype-tests.ss index 2f8f4506..f4bc9912 100644 --- a/collects/tests/typed-scheme/unit-tests/subtype-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/subtype-tests.ss @@ -3,7 +3,7 @@ (require "test-utils.ss") (require (private subtype type-rep type-effect-convenience - planet-requires init-envs type-environments union)) + planet-requires init-envs type-environments union infer infer-dummy)) (require (schemeunit) (for-syntax scheme/base))