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

TR: Added tests for new identifiers and export type names.

Browse Source 
original commit: 0f0b9ebc7a01df4e4d7c079040b0ab0ddaaa05a9
This commit is contained in:
Eric Dobson 2011-06-24 11:20:13 -04:00 committed by Sam Tobin-Hochstadt
parent 6f2514ccd0
commit 9252ba3bc3
6 changed files with 233 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/tests/typed-scheme/succeed/places-helper.rkt Normal file
View File

@ -0,0 +1,13 @@
#lang typed/racket/no-check
(provide double-place echo-place)
(: double-place (Place-Channel -> Void))
(define (double-place pch)
(place-channel-put pch (* 2 (place-channel-get pch))))
(: echo-place (Place-Channel -> Void))
(define (echo-place pch)
(place-channel-put pch (place-channel-get pch)))

19
collects/tests/typed-scheme/succeed/places.rkt Normal file
View File

@ -0,0 +1,19 @@
#lang typed/racket
(: p Place)
(: p2 Place)
(: p3 Place)
(define p (dynamic-place 'tests/typed-scheme/succeed/places-helper 'double-place))
(place-channel-put/get p 10)
(place-wait p)
(define p2 (dynamic-place 'tests/typed-scheme/succeed/places-helper 'double-place))
(place-channel-put/get p2 -2+4i)
(place-wait p2)
(define p3 (dynamic-place 'tests/typed-scheme/succeed/places-helper 'echo-place))
(place-channel-put/get p3 'echo-this)
(place-wait p3)

128
collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
View File

@ -1224,6 +1224,134 @@
(tc-e (udp-addresses (udp-open-socket) #f) (list -String -String))
(tc-e (udp-addresses (udp-open-socket) #t) (list -String -NonNegFixnum -String -NonNegFixnum))
;Byte converters
(tc-e (bytes-open-converter "UTF-8" "UTF-8") (-opt -Bytes-Converter))
(tc-e (let ()
(define: c : Bytes-Converter (assert (bytes-open-converter "UTF-8" "UTF-8")))
(bytes-convert c #"abcde")) (list -Bytes -Nat (one-of/c 'complete 'continues 'aborts 'error)))
(tc-e (let ()
(define: c : Bytes-Converter (assert (bytes-open-converter "UTF-8" "UTF-8")))
(bytes-convert c #"abcde" 0 5 (make-bytes 10))) (list -Nat -Nat (one-of/c 'complete 'continues 'aborts 'error)))
(tc-e (let ()
(define: c : Bytes-Converter (assert (bytes-open-converter "UTF-8" "UTF-8")))
(bytes-convert-end c)) (list -Bytes (one-of/c 'complete 'continues)))
(tc-e (let ()
(define: c : Bytes-Converter (assert (bytes-open-converter "UTF-8" "UTF-8")))
(bytes-convert-end c (make-bytes 10))) (list -Nat (one-of/c 'complete 'continues)))
;Subprocess
(tc-e (subprocess #f #f #f (string->path "/usr/bin/echo") "string" (string->path "path") #"bytes")
(list
-Subprocess
(-opt -Input-Port)
(-opt -Output-Port)
(-opt -Input-Port)))
(tc-e (subprocess #f #f #f (string->path "/usr/bin/echo") 'exact "arg")
(list
-Subprocess
(-opt -Input-Port)
(-opt -Output-Port)
(-opt -Input-Port)))
(tc-e (let ()
(: p Subprocess)
(: std-out (Option Input-Port))
(: std-in (Option Output-Port))
(: std-err (Option Input-Port))
(define-values (p std-out std-in std-err)
(subprocess #f #f #f (string->path "/bin/bash")))
(subprocess? p))
#:ret (ret B (-FS -top -bot)))
;Compilation
(tc-e (compile-syntax #'(+ 1 2)) -Compiled-Expression)
(tc-e (let: ((e : Compiled-Expression (compile #'(+ 1 2))))
(compiled-expression? e))
#:ret (ret B (-FS -top -bot)))
(tc-e (let: ((e : Compiled-Expression (compile #'(module + racket 2))))
(compiled-module-expression? e)) B)
;Impersonator Property
(tc-e (make-impersonator-property 'prop) (list -Impersonator-Property (t:-> Univ B) (t:-> Univ Univ)))
(tc-e (let-values: ((((prop : Impersonator-Property) (pred : (Any -> Any)) (acc : (Any -> Any)))
(make-impersonator-property 'prop)))
(impersonator-property? prop))
#:ret (ret B (-FS -top -bot)))
;Security Guards
(tc-e (make-security-guard (current-security-guard) (lambda args (void)) (lambda args (void))) -Security-Guard)
(tc-e (let: ((s : Security-Guard (current-security-guard)))
(security-guard? s))
#:ret (ret B (-FS -top -bot)))
;Custodians
(tc-e (make-custodian) -Custodian)
(tc-e (let: ((c : Custodian (current-custodian)))
(custodian? c))
#:ret (ret B (-FS -top -bot)))
(tc-e (let: ((c : (CustodianBoxof Integer) (make-custodian-box (current-custodian) 1)))
(custodian-box-value c)) -Int)
;Thread Groups
(tc-e (make-thread-group) -Thread-Group)
(tc-e (let: ((tg : Thread-Group (current-thread-group)))
(thread-group? tg))
#:ret (ret B (-FS -top -bot)))
;Inspector
(tc-e (make-inspector) -Inspector)
(tc-e (let: ((i : Inspector (current-inspector)))
(inspector? i))
#:ret (ret B (-FS -top -bot)))
;Continuation Prompt Tags ang Continuation Mark Sets
(tc-e (default-continuation-prompt-tag) -Prompt-Tag)
(tc-e (let: ((pt : Prompt-Tag (make-continuation-prompt-tag)))
(continuation-marks #f pt)) -Cont-Mark-Set)
(tc-e (let: ((set : Continuation-Mark-Set (current-continuation-marks)))
(continuation-mark-set? set)) #:ret (ret B (-FS -top -bot)))
;Logging
(tc-e (make-logger 'name) -Logger)
(tc-e (let: ((l : Logger (make-logger)))
(let: ((lr : Log-Receiver (make-log-receiver l 'error)))
(log-message l 'error "Message" 'value))) -Void)
;Semaphores
(tc-e (make-semaphore) -Semaphore)
(tc-e (let: ((s : Semaphore (make-semaphore 3)))
(semaphore-post s)) -Void)
;Random Numbers
(tc-e (make-pseudo-random-generator) -Pseudo-Random-Generator)
(tc-e (let: ((pg : Pseudo-Random-Generator (make-pseudo-random-generator)))
(pseudo-random-generator->vector pg)) (make-HeterogenousVector (list -PosInt -PosInt -PosInt -PosInt -PosInt -PosInt)))
;Structure Type Properties
(tc-e (make-struct-type-property 'prop) (list -Struct-Type-Property (t:-> Univ B) (t:-> Univ Univ)))
(tc-e (let-values: ((((prop : Struct-Type-Property) (pred : (Any -> Any)) (acc : (Any -> Any)))
(make-struct-type-property 'prop)))
(struct-type-property? prop))
#:ret (ret B (-FS -top -bot)))
;Wills
(tc-e (make-will-executor) -Will-Executor)
(tc-e (let: ((w : Will-Executor (make-will-executor)))
(will-register w 'a (lambda: ((s : Symbol)) (void)))
(will-execute w)) ManyUniv)
;Promises
;For some reason they are failing in the test suite
#|
(tc-e (delay 's) (-Promise -Symbol))
(tc-e (let: ((p : (Promise Symbol) (delay 's)))
(promise-running? p)) B)
|#
)

77
collects/typed-scheme/base-env/base-env.rkt
View File

@ -1040,31 +1040,52 @@
[bytes-open-converter (-> -String -String -BytesConverter)]
[bytes-close-converter (-> -BytesConverter -Void)]
[bytes-open-converter (-> -String -String (-opt -Bytes-Converter))]
[bytes-close-converter (-> -Bytes-Converter -Void)]
[bytes-convert
(->opt -BytesConverter
-Bytes
[-Nat
(cl->*
(->opt -Bytes-Converter
-Bytes
[-Nat
-Nat
(-val #f)
-Nat
(-opt -Nat)]
(-values (list
-Bytes
-Nat
(Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error)))))
(->opt -Bytes-Converter
-Bytes
-Nat
(-opt -Bytes)
-Nat
(-opt -Nat)]
(-values (list
(Un -Bytes -Nat)
-Nat
(Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error)))))]
-Bytes
[-Nat
(-opt -Nat)]
(-values (list
-Nat
-Nat
(Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error))))))]
[bytes-convert-end
(->opt -BytesConverter
[(-opt -Bytes)
-Nat
(-opt -Nat)]
(-values (list
(Un -Bytes -Nat)
(Un (-val 'complete) (-val 'continues)))))]
(cl->*
(->opt -Bytes-Converter
[(-val #f)
-Nat
(-opt -Nat)]
(-values (list
-Bytes
(Un (-val 'complete) (-val 'continues)))))
(->opt -Bytes-Converter
-Bytes
[-Nat
(-opt -Nat)]
(-values (list
-Nat
(Un (-val 'complete) (-val 'continues))))))]
[bytes-converter? (make-pred-ty -BytesConverter)]
[bytes-converter? (make-pred-ty -Bytes-Converter)]
[locale-string-encoding (-> -String)]
@ -1718,10 +1739,10 @@
[current-read-interaction (-Param (-> Univ -Input-Port Univ) (-> Univ -Input-Port Univ))]
[current-print (-Param (-> Univ ManyUniv) (-> Univ ManyUniv))]
[current-compile (-Param (-> Univ B -CompiledExpression) (-> Univ B -CompiledExpression))]
[compile (-> Univ -CompiledExpression)]
[compile-syntax (-> (-Syntax Univ) -CompiledExpression)]
[compiled-expression? (make-pred-ty -CompiledExpression)]
[current-compile (-Param (-> Univ B -Compiled-Expression) (-> Univ B -Compiled-Expression))]
[compile (-> Univ -Compiled-Expression)]
[compile-syntax (-> (-Syntax Univ) -Compiled-Expression)]
[compiled-expression? (make-pred-ty -Compiled-Expression)]
[compile-enforce-module-constants (-Param B B)]
[compile-allow-set!-undefined (-Param B B)]
@ -1950,11 +1971,11 @@
[logger-name (-> -Logger (-opt Sym))]
[current-logger (-Param -Logger -Logger)]
[log-message (-> -Logger -LogLevel -String Univ -Void)]
[log-level? (-> -Logger -LogLevel B)]
[log-message (-> -Logger -Log-Level -String Univ -Void)]
[log-level? (-> -Logger -Log-Level B)]
[log-receiver? (make-pred-ty -LogReceiver)]
[make-log-receiver (-> -Logger -LogLevel -LogReceiver)]
[log-receiver? (make-pred-ty -Log-Receiver)]
[make-log-receiver (-> -Logger -Log-Level -Log-Receiver)]
;Section 10.2.3 Semaphores
@ -2518,6 +2539,6 @@
;Section 15.3 (Wills and Executors)
[make-will-executor (-> -Will-Executor)]
[will-executor? (make-pred-ty -Will-Executor)]
[will-register (-poly (a) (-> -Will-Executor a (-> a ManyUniv)))]
[will-register (-poly (a) (-> -Will-Executor a (-> a ManyUniv) -Void))]
[will-execute (-> -Will-Executor ManyUniv)]
[will-try-execute (-> -Will-Executor ManyUniv)]

17
collects/typed-scheme/base-env/base-types.rkt
View File

@ -103,6 +103,7 @@
[Module-Path -Module-Path]
[Module-Path-Index -Module-Path-Index]
[Compiled-Module-Expression -Compiled-Module-Expression]
[Compiled-Expression -Compiled-Expression]
[Read-Table -Read-Table]
[Special-Comment -Special-Comment]
[Struct-Type-Property -Struct-Type-Property]
@ -114,7 +115,20 @@
[Namespace-Anchor -Namespace-Anchor]
[Variable-Reference -Variable-Reference]
[Internal-Definition-Context -Internal-Definition-Context]
[Subprocess -Subprocess]
[Security-Guard -Security-Guard]
[Thread-Group -Thread-Group]
[Impersonator-Property -Impersonator-Property]
[Semaphore -Semaphore]
[Bytes-Converter -Bytes-Converter]
[Pseudo-Random-Generator -Pseudo-Random-Generator]
[Logger -Logger]
[Log-Receiver -Log-Receiver]
[Log-Level -Log-Level]
[Place-Channel -Place-Channel]
[Place -Place]
[Will-Executor -Will-Executor]
[Prompt-Tag -Prompt-Tag]
[Listof -Listof]
@ -139,4 +153,5 @@
[MListof (-poly (a) (-mlst a))]
[Sequenceof (-poly (a) (-seq a))]
[ThreadCellof (-poly (a) (-thread-cell a))]
[CustodianBoxof (-poly (a) (make-CustodianBox a))]

11
collects/typed-scheme/types/abbrev.rkt
View File

@ -160,7 +160,12 @@
(define -Resolved-Module-Path (make-Base 'Resolved-Module-Path #'resolved-module-path? resolved-module-path? #'-Resolved-Module-Path))
(define -Module-Path-Index (make-Base 'Module-Path-Index #'module-path-index? module-path-index? #'-Module-Path-Index))
(define -Compiled-Module-Expression (make-Base 'Compiled-Module-Expression #'compiled-module-expression? compiled-module-expression? #'-Compiled-Module-Expression))
(define -CompiledExpression (make-Base 'CompiledExpression #'compiled-expression? compiled-expression? #'-CompiledExpression))
(define -Compiled-Non-Module-Expression
(make-Base 'Compiled-Non-Module-Expression
#'(and/c compiled-expression? (not/c compiled-module-expression?))
(conjoin compiled-expression? (negate compiled-module-expression?))
#'-CompiledExpression))
(define -Compiled-Expression (*Un -Compiled-Module-Expression -Compiled-Non-Module-Expression))
(define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag? continuation-prompt-tag? #'-Prompt-Tag))
(define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set? continuation-mark-set? #'-Cont-Mark-Set))
(define -Path (make-Base 'Path #'path? path? #'-Path))
@ -243,13 +248,13 @@
(define -Semaphore (make-Base 'Semaphore #'semaphore? semaphore? #'-Semaphore))
(define -BytesConverter (make-Base 'BytesConverter #'bytes-converter? bytes-converter? #'-BytesConverter))
(define -Bytes-Converter (make-Base 'Bytes-Converter #'bytes-converter? bytes-converter? #'-Bytes-Converter))
(define -Pseudo-Random-Generator
(make-Base 'Pseudo-Random-Generator #'pseudo-random-generator? pseudo-random-generator? #'-Pseudo-Random-Generator))
(define -Logger (make-Base 'Logger #'logger? logger? #'-Logger))
(define -LogReceiver (make-Base 'LogReceiver #'log-receiver? log-receiver? #'-LogReceiver))
(define -Log-Receiver (make-Base 'LogReceiver #'log-receiver? log-receiver? #'-Log-Receiver))
(define -Place