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

collects/tests/typed-scheme/succeed/places-helper.rkt

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

collects/tests/typed-scheme/succeed/places.rkt

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

collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt

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

collects/typed-scheme/base-env/base-env.rkt

@@ -1040,31 +1040,52 @@
 
 
 
-[bytes-open-converter (-> -String -String -BytesConverter)]
+[bytes-open-converter (-> -String -String (-opt -Bytes-Converter))]
-[bytes-close-converter (-> -BytesConverter -Void)]
+[bytes-close-converter (-> -Bytes-Converter -Void)]
 [bytes-convert
- (->opt -BytesConverter
+ (cl->*
+  (->opt -Bytes-Converter
          -Bytes
          [-Nat
           -Nat
-         (-opt -Bytes)
+          (-val #f)
           -Nat
           (-opt -Nat)]
     (-values (list
-             (Un -Bytes -Nat)
+              -Bytes
               -Nat
-             (Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error)))))]
+              (Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error)))))
+
+  (->opt -Bytes-Converter
+         -Bytes
+         -Nat
+         -Nat
+         -Bytes
+         [-Nat
+          (-opt -Nat)]
+    (-values (list
+              -Nat
+              -Nat
+              (Un (-val 'complete) (-val 'continues) (-val 'aborts) (-val 'error))))))]
 
 [bytes-convert-end
- (->opt -BytesConverter
+ (cl->*
-        [(-opt -Bytes)
+  (->opt -Bytes-Converter
+         [(-val #f)
           -Nat
           (-opt -Nat)]
     (-values (list
-             (Un -Bytes -Nat)
+              -Bytes
-             (Un (-val 'complete) (-val 'continues)))))]
+              (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))]
+[current-compile (-Param (-> Univ B -Compiled-Expression) (-> Univ B -Compiled-Expression))]
-[compile (-> Univ -CompiledExpression)]
+[compile (-> Univ -Compiled-Expression)]
-[compile-syntax (-> (-Syntax Univ) -CompiledExpression)]
+[compile-syntax (-> (-Syntax Univ) -Compiled-Expression)]
-[compiled-expression? (make-pred-ty -CompiledExpression)]
+[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-message (-> -Logger -Log-Level -String Univ -Void)]
-[log-level? (-> -Logger -LogLevel  B)]
+[log-level? (-> -Logger -Log-Level  B)]
 
-[log-receiver? (make-pred-ty -LogReceiver)]
+[log-receiver? (make-pred-ty -Log-Receiver)]
-[make-log-receiver (-> -Logger -LogLevel -LogReceiver)]
+[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)]

collects/typed-scheme/base-env/base-types.rkt

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

collects/typed-scheme/types/abbrev.rkt

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

collects/typed-scheme/types/convenience.rkt

@@ -96,5 +96,5 @@
                                 (-lst* -String)
                                 (-lst* -String (-lst* -String -String #:tail (make-Listof (*Un -Nat (-lst* (*Un -Nat (one-of/c '= '+ '-)) -Nat)))))))))
 
-(define -LogLevel (one-of/c 'fatal 'error 'warning 'info 'debug))
+(define -Log-Level (one-of/c 'fatal 'error 'warning 'info 'debug))