diff --git a/collects/plai/gc2/collector.rkt b/collects/plai/gc2/collector.rkt index 4ff7cc5542..90e64e3eae 100644 --- a/collects/plai/gc2/collector.rkt +++ b/collects/plai/gc2/collector.rkt @@ -33,9 +33,11 @@ (syntax-case stx () [(_ body ...) (with-syntax ([(init-allocator gc:deref gc:alloc-flat gc:cons gc:first gc:rest gc:flat? + gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref gc:cons? gc:set-first! gc:set-rest!) (map (λ (s) (datum->syntax stx s)) '(init-allocator gc:deref gc:alloc-flat gc:cons gc:first gc:rest gc:flat? + gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref gc:cons? gc:set-first! gc:set-rest!))]) #`(#%module-begin @@ -47,12 +49,17 @@ (provide/contract (gc:alloc-flat (heap-value? . -> . location?))) (provide/contract (gc:cons (location? location? . -> . location?))) - + (provide/contract (gc:closure (closure-code? (vectorof location?) . -> . location?))) + + (provide/contract (gc:closure-code-ptr (location? . -> . closure-code?))) + (provide/contract (gc:closure-env-ref (location? integer? . -> . location?))) + (provide/contract (gc:first (location? . -> . location?))) (provide/contract (gc:rest (location? . -> . location?))) (provide/contract (gc:flat? (location? . -> . boolean?))) (provide/contract (gc:cons? (location? . -> . boolean?))) + (provide/contract (gc:closure? (location? . -> . boolean?))) (provide/contract (gc:set-first! (location? location? . -> . void?))) (provide/contract (gc:set-rest! (location? location? . -> . void?))) diff --git a/collects/plai/gc2/collector/lang/reader.rkt b/collects/plai/gc2/collector/lang/reader.rkt index f170a4281d..a94053e90d 100644 --- a/collects/plai/gc2/collector/lang/reader.rkt +++ b/collects/plai/gc2/collector/lang/reader.rkt @@ -1,2 +1,2 @@ (module reader syntax/module-reader - #:language `plai/collector) + #:language `plai/gc2/collector) diff --git a/collects/plai/gc2/mutator.rkt b/collects/plai/gc2/mutator.rkt index 81c957bd6e..824adf9b3b 100644 --- a/collects/plai/gc2/mutator.rkt +++ b/collects/plai/gc2/mutator.rkt @@ -179,20 +179,23 @@ #f)) (string->symbol "#"))]) (quasisyntax/loc stx - (let ([closure (lambda (id ...) - (syntax-parameterize ([mutator-env-roots - (list #'id ... - #'free-id ...)] - [mutator-tail-call? #t]) - (->address body)))]) - (add-closure-env! closure (list (make-env-root free-id) ...)) + (let ([closure + (closure-code + #,(length (syntax->list #'(free-id ...))) + (lambda (free-id ... id ...) + (syntax-parameterize ([mutator-env-roots + (list #'id ... + #'free-id ...)] + [mutator-tail-call? #t]) + (->address body))))]) #,(if (syntax-parameter-value #'mutator-tail-call?) (syntax/loc stx - (#%app collector:alloc-flat closure)) + (#%app collector:closure closure (vector free-id ...))) (syntax/loc stx - (with-continuation-mark gc-roots-key - (list (make-env-root env-id) ...) - (#%app collector:alloc-flat closure))))))))] + (with-continuation-mark + gc-roots-key + (list (make-env-root env-id) ...) + (#%app collector:closure closure (vector free-id ...)))))))))] [(_ (id ...) body ...) (syntax/loc stx (mutator-lambda (id ...) (mutator-begin body ...)))])) @@ -282,11 +285,13 @@ (syntax-case stx () [(collector-module heap-size) (with-syntax ([(init-allocator gc:deref gc:alloc-flat gc:cons + gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref gc:first gc:rest gc:flat? gc:cons? gc:set-first! gc:set-rest!) (map (λ (s) (datum->syntax stx s)) '(init-allocator gc:deref gc:alloc-flat gc:cons + gc:closure gc:closure? gc:closure-code-ptr gc:closure-env-ref gc:first gc:rest gc:flat? gc:cons? gc:set-first! gc:set-rest!))]) @@ -305,11 +310,15 @@ (set-collector:cons?! gc:cons?) (set-collector:set-first!! gc:set-first!) (set-collector:set-rest!! gc:set-rest!) + (set-collector:closure! gc:closure) + (set-collector:closure?! gc:closure?) + (set-collector:closure-code-ptr! gc:closure-code-ptr) + (set-collector:closure-env-ref! gc:closure-env-ref) (init-heap! (#%datum . heap-size)) (when (gui-available?) (if (<= (#%datum . heap-size) 500) - (set-ui! (dynamic-require `plai/private/gc-gui 'heap-viz%)) + (set-ui! (dynamic-require `plai/gc2/private/gc-gui 'heap-viz%)) (printf "Large heap; the heap visualizer will not be displayed.\n"))) (init-allocator))))] [_ (raise-syntax-error 'mutator @@ -390,8 +399,20 @@ (andmap identifier? (syntax->list #'(id ...))) (with-syntax ([(lifted-id ...) (generate-temporaries #'(id ...))]) #'(begin - (define lifted-id (mutator-lift id)) ... - (provide (rename-out [lifted-id id] ...))))])) + (define-syntax lifted-id + (make-set!-transformer + (lambda (stx) + (syntax-case stx (set!) + ;; Redirect mutation of x to y + [(set! x v) + (raise-syntax-error 'id "Cannot mutate primitive functions")] + [(x (... ...)) + #'(mutator-app x (... ...))] + [x (identifier? #'x) + #'(collector:closure (closure-code 0 (mutator-lift id)) (vector))])))) + ... + (provide (rename-out [lifted-id id] + ...))))])) (provide/lift symbol? boolean? number? symbol=? @@ -460,20 +481,28 @@ [(_ arg) #'(#%app print-only-errors (#%datum . arg))])) ; Implementation Functions -(define (deref proc/loc) - (cond - [(procedure? proc/loc) proc/loc] - [(location? proc/loc) (collector:deref proc/loc)] - [else (error 'deref "expected or ; received ~a" proc/loc)])) - (define (deref-proc proc-or-loc) + (define (deref proc/loc) + (cond + [(procedure? proc/loc) proc/loc] + [(location? proc/loc) (collector:closure-code-ptr proc/loc)] + [else (error 'deref "expected or ; received ~a" proc/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))) + (cond + [(procedure? v) + v] + [(closure-code? v) + (lambda args + (apply (closure-code-proc v) + (append + (for/list ([i (in-range (closure-code-env-count v))]) + (collector:closure-env-ref proc-or-loc i)) + args)))] + [else + (error 'procedure-application "expected procedure, given ~e" v)])) (define (gc->scheme loc) (define-struct an-unset ()) @@ -494,8 +523,11 @@ (placeholder-set! ph (cons car-ph cdr-ph)) (placeholder-set! car-ph (unwrap (collector:first loc))) (placeholder-set! cdr-ph (unwrap (collector:rest loc))))] + [(collector:closure? loc) + ;; XXX get env? + (placeholder-set! ph (closure-code-proc (collector:closure-code-ptr loc)))] [else - (error (format "gc:flat? and gc:cons? both returned false for ~a" loc))]) + (error (format "gc:flat?, gc:cons?, gc:closure? all returned false for ~a" loc))]) (placeholder-get ph))))) (make-reader-graph (unwrap loc))) diff --git a/collects/plai/gc2/mutator/lang/reader.rkt b/collects/plai/gc2/mutator/lang/reader.rkt index 370ea7039c..bb383b60be 100644 --- a/collects/plai/gc2/mutator/lang/reader.rkt +++ b/collects/plai/gc2/mutator/lang/reader.rkt @@ -1,2 +1,2 @@ (module reader syntax/module-reader - #:language `plai/mutator) + #:language `plai/gc2/mutator) diff --git a/collects/plai/gc2/private/collector-exports.rkt b/collects/plai/gc2/private/collector-exports.rkt index a8ac1f0b53..539efa4f29 100644 --- a/collects/plai/gc2/private/collector-exports.rkt +++ b/collects/plai/gc2/private/collector-exports.rkt @@ -1,39 +1,32 @@ #lang scheme +(require (for-syntax racket/syntax)) (provide (all-defined-out)) -(define collector:deref false) -(define collector:alloc-flat false) -(define collector:cons false) -(define collector:first false) -(define collector:rest false) -(define collector:flat? false) -(define collector:cons? false) -(define collector:set-first! false) -(define collector:set-rest! false) +(define-syntax (define-collector-export stx) + (syntax-case stx () + [(_ i) + (with-syntax + ([collector:i (format-id #'i "collector:~a" #'i)] + [set-collector:i! (format-id #'i "set-collector:~a!" #'i)]) + #'(begin (define collector:i false) + (define (set-collector:i! proc) + (set! collector:i proc))))])) -(define (set-collector:deref! proc) - (set! collector:deref proc)) +(define-syntax-rule (define-collector-exports i ...) + (begin (define-collector-export i) + ...)) -(define (set-collector:alloc-flat! proc) - (set! collector:alloc-flat proc)) - -(define (set-collector:cons! proc) - (set! collector:cons proc)) - -(define (set-collector:first! proc) - (set! collector:first proc)) - -(define (set-collector:rest! proc) - (set! collector:rest proc)) - -(define (set-collector:flat?! proc) - (set! collector:flat? proc)) - -(define (set-collector:cons?! proc) - (set! collector:cons? proc)) - -(define (set-collector:set-first!! proc) - (set! collector:set-first! proc)) - -(define (set-collector:set-rest!! proc) - (set! collector:set-rest! proc)) +(define-collector-exports + deref + alloc-flat + cons + first + rest + flat? + cons? + set-first! + set-rest! + closure + closure? + closure-code-ptr + closure-env-ref) diff --git a/collects/plai/gc2/private/gc-core.rkt b/collects/plai/gc2/private/gc-core.rkt index efa922faa8..31661478d2 100644 --- a/collects/plai/gc2/private/gc-core.rkt +++ b/collects/plai/gc2/private/gc-core.rkt @@ -50,10 +50,10 @@ (string-append " " (format-cell elt)))]))))) ;;; Predicate determines values that may be stored on the heap. Limit this to "small" values that -;;; conceptually occupy a small, fixed amount of space. Closures are an exception. +;;; conceptually occupy a small, fixed amount of space. (provide/contract [heap-value? (any/c . -> . boolean?)]) (define (heap-value? v) - (or (number? v) (symbol? v) (boolean? v) (empty? v) (procedure? v))) + (or (number? v) (symbol? v) (boolean? v) (empty? v) (closure-code? v))) (provide location?) (define (location? v) @@ -87,16 +87,22 @@ (define gc-roots-key (gensym 'gc-roots-key)) ;;; Roots are defined with custom getters and setters as they can be created in various ways. -(provide root? root-name make-root) (define-struct root (name get set!) #:property prop:custom-write (λ (v port write?) (display (format "#" (root-name v)) port))) +(provide/contract + [root? (-> any/c boolean?)] + [root-name (-> root? any/c)] + [make-root (-> any/c (-> location?) (-> location? void) root?)]) (provide make-env-root) (define-syntax (make-env-root stx) (syntax-case stx () [(_ id) (identifier? #'id) - #`(make-root 'id (λ () id) (λ (loc) (set! id loc)))])) + #`(make-root 'id + (λ () + id) + (λ (loc) (set! id loc)))])) ;;; Roots on the stack. (provide/contract (stack-roots (-> (listof root?)))) @@ -110,7 +116,10 @@ (provide/contract (make-stack-root (symbol? location? . -> . root?))) (define (make-stack-root id location) - (make-root id (λ () location) (λ (new-location) (set! location new-location)))) + (make-root id + (λ () + location) + (λ (new-location) (set! location new-location)))) (provide/contract (read-root (root? . -> . location?))) (define (read-root root) @@ -137,9 +146,13 @@ (andmap identifier? (syntax->list #'(root-id ...))) #`(begin (append - (list (make-root 'root-id (λ () root-id) - (λ (loc) - (set! root-id loc))) + (list (if (location? root-id) + (make-root 'root-id + (λ () + root-id) + (λ (loc) + (set! root-id loc))) + (error 'get-root-set "expected a location, given ~e" root-id)) ...) (get-global-roots) (stack-roots)))] @@ -153,24 +166,23 @@ "missing open parenthesis" stx)])) +(provide/contract + [vector->roots (-> (vectorof location?) (listof root?))]) +(define (vector->roots v) + (for/list ([e (in-vector v)] + [i (in-naturals)]) + (make-root 'vector + (λ () + (vector-ref v i)) + (λ (ne) (vector-set! v ne))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Environments of closures -; Once the closure is garbage collected, its environment is only reachable by a weak reference to -; the closure. -(define closure-envs (make-weak-hash)) - -(provide/contract (add-closure-env! (procedure? (listof root?) . -> . any))) -(define (add-closure-env! proc roots) - (hash-set! closure-envs proc roots)) - -(provide/contract (get-closure-env (procedure? . -> . (or/c false/c (listof root?))))) -(define (get-closure-env proc) - (hash-ref closure-envs proc false)) - -(provide/contract (procedure-roots (procedure? . -> . (listof root?)))) -(define (procedure-roots proc) - (filter is-mutable-root? (hash-ref closure-envs proc empty))) +(define-struct closure-code (env-count proc) #:transparent) +(provide/contract + [struct closure-code ([env-count exact-nonnegative-integer?] + [proc procedure?])]) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Optional UI diff --git a/collects/plai/gc2/private/gc-gui.rkt b/collects/plai/gc2/private/gc-gui.rkt index 61100a8cd8..0a53fe91ff 100644 --- a/collects/plai/gc2/private/gc-gui.rkt +++ b/collects/plai/gc2/private/gc-gui.rkt @@ -103,10 +103,8 @@ (cond [(boolean? obj) (if obj "#t" "#f")] [(number? obj) (format "~a" obj)] - [(procedure? obj) - (if (object-name obj) - (format "~a" (object-name obj)) - "#")] + [(closure-code? obj) + (format "~a" (or (object-name (closure-code-proc obj)) "#"))] [(symbol? obj) (format "'~s" obj)] [(null? obj) "empty"] [else (error 'val->string "unknown object, expected a heap-value.")])) @@ -324,8 +322,8 @@ (<= 0 n) (< n (vector-length heap-vec))) (list n)] - [(procedure? n) - (map read-root (procedure-roots n))] + [(closure-code? n) + '()] [else '()])) '())) diff --git a/collects/tests/plai/gc2/bad-collectors/no-collection-collector.rkt b/collects/tests/plai/gc2/bad-collectors/no-collection-collector.rkt index 2d3a04a593..21d08d8302 100644 --- a/collects/tests/plai/gc2/bad-collectors/no-collection-collector.rkt +++ b/collects/tests/plai/gc2/bad-collectors/no-collection-collector.rkt @@ -1,4 +1,4 @@ -#lang plai/gc2collector +#lang plai/gc2/collector (define ptr 0) diff --git a/collects/tests/plai/gc2/good-collectors/good-collector.rkt b/collects/tests/plai/gc2/good-collectors/good-collector.rkt index fdfeb83b3c..c1339bd16b 100644 --- a/collects/tests/plai/gc2/good-collectors/good-collector.rkt +++ b/collects/tests/plai/gc2/good-collectors/good-collector.rkt @@ -1,4 +1,4 @@ -#lang plai/gc2collector +#lang plai/gc2/collector #| @@ -68,7 +68,7 @@ A collector for use in testing the random mutator generator. [(equal? (heap-ref loc) 'flat) (heap-ref (+ loc 1))] [else - (error 'gc:deref "attempted to deref a non flat value, loc ~s" loc)])) + (error 'gc:deref "attempted to deref a non flat value, loc ~s, tag ~s" loc (heap-ref loc))])) (test (with-heap (vector 'free 'free 'free 'flat 14 'free 'free) (gc:deref 3)) @@ -92,6 +92,18 @@ A collector for use in testing the random mutator generator. (gc:rest 3)) 1) +(define (gc:closure-code-ptr a) + (if (gc:closure? a) + (heap-ref (+ a 1)) + (error 'closure-code "non closure"))) + +;; XXX test + +(define (gc:closure-env-ref a i) + (if (gc:closure? a) + (heap-ref (+ a 3 i)) + (error 'closure-env-ref "non closure"))) + (define (gc:flat? loc) (equal? (heap-ref loc) 'flat)) (test (with-heap (vector 'free 'free 'pair 0 1 'flat 14) @@ -110,6 +122,15 @@ A collector for use in testing the random mutator generator. (gc:cons? 5)) #f) +(define (gc:closure? loc) (equal? (heap-ref loc) 'closure)) + +(test (with-heap (vector 'free 'free 'closure #f 0 'flat 14) + (gc:closure? 2)) + #t) +(test (with-heap (vector 'free 'free 'closure #f 0 'flat 14) + (gc:closure? 5)) + #f) + (define (gc:set-first! pr-ptr new) (if (equal? (heap-ref pr-ptr) 'pair) (heap-set! (+ pr-ptr 1) new) @@ -122,11 +143,7 @@ A collector for use in testing the random mutator generator. (define (gc:alloc-flat fv) - (let ([ptr (alloc 2 (λ () - (if (procedure? fv) - (append (procedure-roots fv) - (get-root-set)) - (get-root-set))))]) + (let ([ptr (alloc 2 (λ () (get-root-set)))]) (heap-set! ptr 'flat) (heap-set! (+ ptr 1) fv) ptr)) @@ -138,6 +155,17 @@ A collector for use in testing the random mutator generator. (heap-set! (+ ptr 2) tl) ptr)) +(define (gc:closure code env) + (define len (vector-length env)) + (define ptr (alloc (+ 3 len) (λ () (append (get-root-set) (vector->roots env))))) + (heap-set! ptr 'closure) + (heap-set! (+ ptr 1) code) + (heap-set! (+ ptr 2) len) + (for ([v (in-vector env)] + [i (in-naturals)]) + (heap-set! (+ ptr 3 i) v)) + ptr) + (define (alloc n get-roots) (let ([next (find-free-space 0 n)]) (cond @@ -162,18 +190,27 @@ A collector for use in testing the random mutator generator. (case (heap-ref (car gray)) [(flat) (let ([proc (heap-ref (+ (car gray) 1))]) - (if (procedure? proc) - (let ([new-locs (map read-root (procedure-roots proc))]) - (collect-garbage-help - (add-in new-locs (cdr gray) white) - (remove* new-locs white))) - (collect-garbage-help (cdr gray) white)))] + (collect-garbage-help (cdr gray) white))] [(pair) (let ([hd (heap-ref (+ (car gray) 1))] [tl (heap-ref (+ (car gray) 2))]) (collect-garbage-help (add-in (list hd tl) (cdr gray) white) (remove tl (remove hd white))))] + [(closure) + (define env-count + (heap-ref (+ (car gray) 2))) + (define-values + (gray* white*) + (for/fold ([gray* (cdr gray)] + [white* white]) + ([i (in-range env-count)]) + (define env (gc:closure-env-ref (car gray) i)) + (values (add-in (list env) gray* white) + (remove env white*)))) + (collect-garbage-help + gray* + white*)] [else (error 'collect-garbage "unknown tag ~s, loc ~s" (heap-ref (car gray)) (car gray))])])) @@ -190,6 +227,12 @@ A collector for use in testing the random mutator generator. [(flat) (heap-set! white 'free) (heap-set! (+ white 1) 'free)] + [(closure) + (heap-set! white 'free) + (heap-set! (+ white 1) 'free) + (for ([i (in-range (heap-ref (+ white 2)))]) + (heap-set! (+ white 3 i) 'free)) + (heap-set! (+ white 2) 'free)] [else (error 'free! "unknown tag ~s\n" (heap-ref white))]) (free! (cdr whites)))])) @@ -221,15 +264,16 @@ A collector for use in testing the random mutator generator. (cond [(< i (heap-size)) (case (heap-ref i) + [(closure) (cons i (get-all-records (+ i 3 (heap-ref (+ i 2)))))] [(pair) (cons i (get-all-records (+ i 3)))] [(flat) (cons i (get-all-records (+ i 2)))] [(free) (get-all-records (+ i 1))] - [else (get-all-records (+ i 1))])] + [else (error 'get-all-records "Unknown tag ~e in cell ~e" (heap-ref i) i)])] [else null])) -(test (with-heap (vector #f #t '() 0 1 2 3 4 5 6 'pair 0 1 'flat 14 'pair 0 1 'flat 12) - (get-all-records 0)) - (list 10 13 15 18)) +(test (with-heap (vector #f #t '() 0 1 2 3 4 5 6 'pair 0 1 'flat 14 'pair 0 1 'flat 12 'closure #f 1 10 'flat 16) + (get-all-records 10)) + (list 10 13 15 18 20 24)) (test (with-heap (make-vector 10 'free) (gc:alloc-flat #f)) 0) @@ -272,3 +316,4 @@ A collector for use in testing the random mutator generator. (remove 4 (get-all-records 0)))) v) (vector 'free 'free 'free 'free 'pair 4 4)) + diff --git a/collects/tests/plai/gc2/good-collectors/trivial-collector.rkt b/collects/tests/plai/gc2/good-collectors/trivial-collector.rkt index 85cf803967..903fbfe8e9 100644 --- a/collects/tests/plai/gc2/good-collectors/trivial-collector.rkt +++ b/collects/tests/plai/gc2/good-collectors/trivial-collector.rkt @@ -1,10 +1,30 @@ -#lang plai/gc2collector +#lang plai/gc2/collector (define heap-ptr 'uninitialized-heap-ptr) (define (init-allocator) ; calling heap-offset before init-allocator is called gives 'undefined (set! heap-ptr 0)) +(define (gc:closure code vs) + (define len (vector-length vs)) + (when (> (+ heap-ptr len) (heap-size)) + (error "out of memory")) + (heap-set! heap-ptr 'closure) + (heap-set! (+ 1 heap-ptr) code) + (for ([v (in-vector vs)] + [i (in-naturals 1)]) + (heap-set! (+ 1 i heap-ptr) v)) + (set! heap-ptr (+ len heap-ptr)) + ;; return the location of this flat data + (- heap-ptr len)) + +(define (gc:closure-code-ptr a) + (heap-ref (+ a 1))) +(define (gc:closure-env-ref a i) + (heap-ref (+ a 1 1 i))) +(define (gc:closure? a) + (eq? (heap-ref a) 'closure)) + (define (gc:alloc-flat p) (begin (when (> (+ heap-ptr 2) (heap-size)) diff --git a/collects/tests/plai/gc2/good-mutators/danny-bug.rkt b/collects/tests/plai/gc2/good-mutators/danny-bug.rkt index a8d6b4ffd8..2a16a3091b 100644 --- a/collects/tests/plai/gc2/good-mutators/danny-bug.rkt +++ b/collects/tests/plai/gc2/good-mutators/danny-bug.rkt @@ -1,11 +1,11 @@ #lang plai/gc2/mutator -(allocator-setup "../good-collectors/good-collector.rkt" 6) +(allocator-setup "../good-collectors/good-collector.rkt" 8) (define proc (let* ([not-root 1] ; 2 [root 2]) ; 4 - (lambda () ; 6 + (lambda () ; 8 3 root))) diff --git a/collects/tests/plai/gc2/good-mutators/thunks.rkt b/collects/tests/plai/gc2/good-mutators/thunks.rkt index cf4f28e2c5..534b1a509c 100644 --- a/collects/tests/plai/gc2/good-mutators/thunks.rkt +++ b/collects/tests/plai/gc2/good-mutators/thunks.rkt @@ -1,7 +1,7 @@ #lang plai/gc2/mutator -(allocator-setup "../good-collectors/good-collector.rkt" 4) +(allocator-setup "../good-collectors/good-collector.rkt" 5) -; 2 +; 3 (define thunker (lambda () ; 2 @@ -10,6 +10,6 @@ 'bananna ; 2 'frog)) -; 4 total +; 5 total (thunker) diff --git a/collects/tests/plai/gc2/other-mutators/begin.rkt b/collects/tests/plai/gc2/other-mutators/begin.rkt index a9160eba3e..8afd7d04dd 100644 --- a/collects/tests/plai/gc2/other-mutators/begin.rkt +++ b/collects/tests/plai/gc2/other-mutators/begin.rkt @@ -1,5 +1,5 @@ #lang plai/gc2/mutator -(allocator-setup "../good-collectors/good-collector.rkt" 6) +(allocator-setup "../good-collectors/good-collector.rkt" 7) (define (go) (let ([obj 'z]) diff --git a/collects/tests/plai/gc2/run-test.rkt b/collects/tests/plai/gc2/run-test.rkt index f6e8bdfbe3..d5390cfaaf 100644 --- a/collects/tests/plai/gc2/run-test.rkt +++ b/collects/tests/plai/gc2/run-test.rkt @@ -28,8 +28,8 @@ (test (if (run-good?) (for ([m (in-directory (build-path here "good-mutators") #rx"rkt$")]) - (test - (test-mutator m))) + (test #:failure-prefix (format "~a" m) + (test-mutator m))) (void)) (for ([m (in-directory (build-path here "bad-mutators") #rx"rkt$")]) (test @@ -37,7 +37,7 @@ (test-mutator (build-path here "other-mutators" "error.rkt")) =error> - #rx"plai/gc2mutator has error" + #rx"plai/gc2/mutator has error" (test-mutator (build-path here "other-mutators" "top.rkt")) =error> @@ -48,8 +48,8 @@ #<