Add -v option to TR tests.

Also, print errors from serialization and place message sending.

collects/tests/typed-racket/main.rkt

@@ -71,6 +71,8 @@
          (test
           (build-path path p)
           (λ ()
+            (when (verbose?)
+              (log-warning (format "TR tests: waiting for ~a ~a" dir p)))
             (force prm))))))
   (make-test-suite dir tests)))
 
@@ -147,5 +149,6 @@
 (define (go/text tests) (run-tests tests 'verbose))
 
 (provide go go/text just-one places start-workers
+         verbose?
          int-tests unit-tests compile-benchmarks
          optimization-tests missed-optimization-tests)

collects/tests/typed-racket/places.rkt

@@ -2,11 +2,15 @@
 
 (require racket/place typed-racket/optimizer/logging
          unstable/open-place compiler/compiler)
-(provide start-worker dr serialize-exn deserialize-exn s-exn? generate-log/place)
+(provide start-worker dr serialize-exn deserialize-exn s-exn? generate-log/place verbose?)
+
+(define verbose? (make-parameter #f))
+
 (struct s-exn (message) #:prefab)
 (struct s-exn:fail s-exn () #:prefab)
 (struct s-exn:fail:syntax s-exn:fail (exprs) #:prefab)
 (struct s-exn:fail:contract s-exn:fail () #:prefab)
+
 (define (serialize-exn e)
   (match e
     [(exn:fail:syntax msg _ exprs)
@@ -34,7 +38,9 @@
     (dynamic-require `(file ,(if (string? p) p (path->string p))) #f)
     (and reg-box (set-box! reg-box (namespace-module-registry (current-namespace))))))
 
+
 (define (start-worker get-ch name)
+  (define verb (verbose?))
   (open-place ch
     (define reg (box #f))
     (let loop ()
@@ -49,14 +55,13 @@
          (loop)]
         [(vector p* res error?) 
          (define-values (path p b) (split-path p*))
+         (with-handlers ([exn? (λ (e) (place-channel-put res (serialize-exn e)))])
            (parameterize ([read-accept-reader #t]
                           [current-load-relative-directory
                            (path->complete-path path)]
                           [current-directory path]
                           [current-output-port (open-output-nowhere)]                        
                           [error-display-handler (if error? void (error-display-handler))]) 
-           (with-handlers ([exn? (λ (e)
-                                   (place-channel-put res (serialize-exn e)))])
              (dr p reg)
              (place-channel-put res #t)))
          (loop)]))))

collects/tests/typed-racket/run.rkt

@@ -14,6 +14,7 @@
 (current-namespace (make-base-namespace))
 (command-line
  #:once-each
+ ["-v" "verbose" (verbose? #t)]
  ["--unit" "run the unit tests" (unit? #t)]
  ["--int" "run the integration tests" (int? #t)]
  ["--opt" "run the optimization tests" (opt? #t)]

collects/tests/typed-racket/send-places.rkt

@@ -3,7 +3,7 @@
 (require "places.rkt")
 
 (require racket/place data/queue racket/async-channel)
-(provide generate-log start-workers run-in-other-place places)
+(provide generate-log start-workers run-in-other-place places verbose?)
 
 (define places (make-parameter (and (place-enabled?) (min 8 (processor-count)))))