Copy execution counts (and do it at the right place)
svn: r860
This commit is contained in:
parent
442286672b
commit
d7b59fdd60
|
@ -239,7 +239,7 @@
|
||||||
(cond [html? #"text/html"]
|
(cond [html? #"text/html"]
|
||||||
[wxme? #"application/data"]
|
[wxme? #"application/data"]
|
||||||
[else #"text/plain"])
|
[else #"text/plain"])
|
||||||
`((Content-length . ,(number->string (bytes-length data)))
|
`((Content-Length . ,(number->string (bytes-length data)))
|
||||||
,@(if wxme?
|
,@(if wxme?
|
||||||
`((Content-Disposition
|
`((Content-Disposition
|
||||||
.
|
.
|
||||||
|
|
|
@ -158,9 +158,9 @@
|
||||||
(error what "file access denied (~a)" path)))
|
(error what "file access denied (~a)" path)))
|
||||||
(lambda (what host port mode) (error what "network access denied"))))
|
(lambda (what host port mode) (error what "network access denied"))))
|
||||||
|
|
||||||
(define (safe-eval expr)
|
(define (safe-eval expr . more)
|
||||||
(parameterize ([current-security-guard tight-security])
|
(parameterize ([current-security-guard tight-security])
|
||||||
(eval expr)))
|
(apply eval expr more)))
|
||||||
|
|
||||||
;; Execution ----------------------------------------
|
;; Execution ----------------------------------------
|
||||||
|
|
||||||
|
@ -232,16 +232,17 @@
|
||||||
'((require (lib "errortrace.ss" "errortrace"))
|
'((require (lib "errortrace.ss" "errortrace"))
|
||||||
(execute-counts-enabled #t))))
|
(execute-counts-enabled #t))))
|
||||||
(safe-eval body)
|
(safe-eval body)
|
||||||
(when coverage-enabled
|
|
||||||
(set! execute-counts
|
|
||||||
(filter (lambda (x)
|
|
||||||
(eq? 'program (syntax-source (car x))))
|
|
||||||
(safe-eval '(get-execute-counts)))))
|
|
||||||
(when (and (pair? body) (eq? 'module (car body))
|
(when (and (pair? body) (eq? 'module (car body))
|
||||||
(pair? (cdr body)) (symbol? (cadr body)))
|
(pair? (cdr body)) (symbol? (cadr body)))
|
||||||
(let ([mod (cadr body)])
|
(let ([mod (cadr body)])
|
||||||
(safe-eval `(require ,mod))
|
(safe-eval `(require ,mod))
|
||||||
(current-namespace (module->namespace mod)))))
|
(current-namespace (module->namespace mod))))
|
||||||
|
(when coverage-enabled
|
||||||
|
(set! execute-counts
|
||||||
|
(map (lambda (x) (cons (car x) (cdr x)))
|
||||||
|
(filter (lambda (x)
|
||||||
|
(eq? 'program (syntax-source (car x))))
|
||||||
|
(safe-eval '(get-execute-counts) ns))))))
|
||||||
(channel-put result-ch 'ok))
|
(channel-put result-ch 'ok))
|
||||||
;; Now wait for interaction expressions:
|
;; Now wait for interaction expressions:
|
||||||
(let loop ()
|
(let loop ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user