Fixing error message re Robby and rearranging tests a little

svn: r18117

collects/plai/mutator.ss

@@ -208,12 +208,12 @@
      (with-syntax ([(env-id ...) (syntax-parameter-value #'mutator-env-roots)])
        (if (syntax-parameter-value #'mutator-tail-call?)
            ; If this call is in tail position, we will not need access to its environment when it returns.
-           (syntax/loc stx ((deref fe) ae ...))
+           (syntax/loc stx ((deref-proc fe) ae ...))
            ; If this call is not in tail position, we make the environment at the call site
            ; reachable.
            #`(with-continuation-mark gc-roots-key 
                (list (make-env-root env-id) ...)
-               #,(syntax/loc stx ((deref fe) ae ...)))))]))
+               #,(syntax/loc stx ((deref-proc fe) ae ...)))))]))
 (define-syntax mutator-quote
   (syntax-rules ()
     [(_ (a . d))
@@ -455,6 +455,15 @@
     [(location? proc/loc) (collector:deref proc/loc)]
     [else (error 'deref "expected <location?> or <procedure?>; received ~a" proc/loc)]))
 
+(define (deref-proc proc-or-loc)
+  (define v 
+    (with-handlers ([exn? (lambda (x) 
+                            (error 'procedure-application "expected procedure, given something else"))])
+      (deref proc-or-loc)))
+  (if (procedure? v)
+      v
+      (error 'procedure-application "expected procedure, given ~e" v)))
+
 (define (gc->scheme loc)
   (define-struct an-unset ())
   (define unset (make-an-unset))

collects/tests/plai/gc/bad-mutators/void-app.ss

@@ -0,0 +1,4 @@
+#lang plai/mutator
+(allocator-setup "../good-collectors/no-compact-cheat.ss" 100)
+(define x (cons 1 2))
+((set-first! x 2) 1)

collects/tests/plai/gc/run-test.ss

@@ -14,7 +14,17 @@
   (parameterize ([current-namespace (make-base-empty-namespace)])
     (dynamic-require m #f)))
 
+(define run-good? (make-parameter #f))
+
+(command-line #:program "run-test"
+              #:once-each ["-g" "Enable running good mutators" (run-good? #t)])
+
 (test
+ (if (run-good?)
+     (for ([m (in-directory (build-path here "good-mutators") #rx"ss$")])
+       (test
+        (test-mutator m)))
+     (void))
  (for ([m (in-directory (build-path here "bad-mutators") #rx"ss$")])
    (test
     (test-mutator m) =error> #rx"")))

collects/tests/plai/test-random-mutator.ss

@@ -25,6 +25,7 @@
                                                  (find-relative-path 
                                                   (simple-form-path tmpfile)
                                                   (build-path (simple-form-path here)
+                                                              "gc" "good-collectors"
                                                               "no-compact-cheat.ss")))
                                                100))
         (for-each (λ (exp) (pretty-print exp port)) exps))