suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changes to tests for ...

Browse Source 
original commit: 4ae41412579f7c6daa1d2b527897a50d4f098ea7
This commit is contained in:
Sam Tobin-Hochstadt 2008-06-10 16:40:05 -04:00
parent e52e768126
commit 15f6c532e6
11 changed files with 66 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
collects/tests/typed-scheme/succeed/inst-dots.ss Normal file
View File

@ -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))

4
collects/tests/typed-scheme/succeed/metrics.ss
View File

@ -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")

20
collects/tests/typed-scheme/succeed/poly-subtype.ss Normal file
View File

@ -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)
|#

4
collects/tests/typed-scheme/succeed/random-bits.ss
View File

@ -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 ))

4
collects/tests/typed-scheme/succeed/varargs-tests.ss
View File

@ -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))]))

5
collects/tests/typed-scheme/unit-tests/all-tests.ss
View File

@ -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

4
collects/tests/typed-scheme/unit-tests/infer-tests.ss
View File

@ -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) ...)

2
collects/tests/typed-scheme/unit-tests/parse-type-tests.ss
View File

@ -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)]

2
collects/tests/typed-scheme/unit-tests/remove-intersect-tests.ss
View File

@ -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))

23
collects/tests/typed-scheme/unit-tests/subst-tests.ss Normal file
View File

@ -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)

2
collects/tests/typed-scheme/unit-tests/subtype-tests.ss
View File

@ -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))