Copy execution counts (and do it at the right place)

svn: r860
This commit is contained in:
Eli Barzilay 2005-09-15 22:08:10 +00:00
parent 442286672b
commit d7b59fdd60
2 changed files with 10 additions and 9 deletions

View File

@ -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
. .

View File

@ -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 ()