Steps toward activation in test cases
This commit is contained in:
parent
a39bd458d9
commit
eb33fdbd59
|
@ -4,6 +4,7 @@
|
|||
activate
|
||||
require/activate
|
||||
current-ground-dataspace
|
||||
current-activated-modules
|
||||
begin-for-declarations ;; TODO: this seems like a horrible hack
|
||||
(except-out (all-from-out racket/base) #%module-begin sleep)
|
||||
(all-from-out racket/match)
|
||||
|
@ -36,6 +37,7 @@
|
|||
(begin decl ...))
|
||||
|
||||
(define current-ground-dataspace (make-parameter #f))
|
||||
(define current-activated-modules (make-parameter #f))
|
||||
|
||||
(define-syntax (module-begin stx)
|
||||
(unless (eq? (syntax-local-context) 'module-begin)
|
||||
|
@ -60,13 +62,12 @@
|
|||
|
||||
(module+ syndicate-main
|
||||
(provide activate!* activate!)
|
||||
(define activated? #f)
|
||||
(define (activate!*)
|
||||
#,@(reverse activation-forms)
|
||||
(void))
|
||||
(define (activate!)
|
||||
(when (not activated?)
|
||||
(set! activated? #t)
|
||||
(when (not (hash-has-key? (current-activated-modules) activate!*))
|
||||
(hash-set! (current-activated-modules) activate!* #t)
|
||||
(activate!*))))
|
||||
|
||||
(module+ main (current-ground-dataspace run-ground))
|
||||
|
@ -75,7 +76,8 @@
|
|||
|
||||
(module+ main
|
||||
(require (submod ".." syndicate-main))
|
||||
((current-ground-dataspace) activate!))
|
||||
(parameterize ((current-activated-modules (make-hasheq)))
|
||||
((current-ground-dataspace) activate!)))
|
||||
|
||||
;----------------------------------------
|
||||
))
|
||||
|
|
|
@ -33,6 +33,7 @@
|
|||
|
||||
(require "bag.rkt")
|
||||
(require "main.rkt")
|
||||
(require (only-in "lang.rkt" current-activated-modules))
|
||||
|
||||
(require (for-syntax racket/base))
|
||||
(require (for-syntax syntax/srcloc))
|
||||
|
@ -105,6 +106,7 @@
|
|||
(current-actor-crash-logger
|
||||
(lambda (a e)
|
||||
(set-box! exns-box (cons (list a e) (unbox exns-box)))))
|
||||
(current-activated-modules (make-hasheq))
|
||||
(event-accumulator events-box))
|
||||
(time-apply (lambda () (let loop () (when (run-scripts! ds) (loop))))
|
||||
'())))
|
||||
|
|
Loading…
Reference in New Issue