From 6ce47a9d1e8aba5b083c8e5832571b94d6db5106 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 24 Aug 2010 20:50:46 -0600 Subject: [PATCH] change Scribble's `interaction', etc. to use non-default `current-print' to format results, if one is installed in a sandboxed evaluator original commit: a19899898f1f7774f634ad44df560f4813fec91c --- collects/scribble/eval.rkt | 89 ++++++++++++++---------- collects/scribblings/scribble/eval.scrbl | 20 ++++-- 2 files changed, 70 insertions(+), 39 deletions(-) diff --git a/collects/scribble/eval.rkt b/collects/scribble/eval.rkt index fbc0f1dd..180fabb1 100644 --- a/collects/scribble/eval.rkt +++ b/collects/scribble/eval.rkt @@ -92,40 +92,45 @@ (make-flow (list p)))))) (format-output (cadar val-list+outputs) output-color) (format-output (caddar val-list+outputs) error-color) - (if (string? (caar val-list+outputs)) - ;; Error result case: - (map - (lambda (s) - (car (format-output s error-color))) - (filter - (lambda (s) (not (equal? s ""))) - (let sloop ([s (caar val-list+outputs)]) - (apply - append - (map (lambda (s) - (if ((string-length s) . > . maxlen) - ;; break the error message into multiple lines: - (let loop ([pos (sub1 maxlen)]) - (cond - [(zero? pos) (cons (substring s 0 maxlen) - (sloop (substring s maxlen)))] - [(char-whitespace? (string-ref s pos)) - (cons (substring s 0 pos) - (sloop (substring s (add1 pos))))] - [else (loop (sub1 pos))])) - (list s))) - (regexp-split #rx"\n" s)))))) - ;; Normal result case: - (let ([val-list (caar val-list+outputs)]) - (if (equal? val-list (list (void))) - null - (map (lambda (v) - (list (make-flow (list (make-paragraph - (list - (hspace 2) - (elem #:style result-color - (to-element/no-color v #:expr? (print-as-expression))))))))) - val-list)))) + (cond + [(string? (caar val-list+outputs)) + ;; Error result case: + (map + (lambda (s) + (car (format-output s error-color))) + (filter + (lambda (s) (not (equal? s ""))) + (let sloop ([s (caar val-list+outputs)]) + (apply + append + (map (lambda (s) + (if ((string-length s) . > . maxlen) + ;; break the error message into multiple lines: + (let loop ([pos (sub1 maxlen)]) + (cond + [(zero? pos) (cons (substring s 0 maxlen) + (sloop (substring s maxlen)))] + [(char-whitespace? (string-ref s pos)) + (cons (substring s 0 pos) + (sloop (substring s (add1 pos))))] + [else (loop (sub1 pos))])) + (list s))) + (regexp-split #rx"\n" s))))))] + [(box? (caar val-list+outputs)) + ;; Output formatted as string: + (format-output (unbox (caar val-list+outputs)) result-color)] + [else + ;; Normal result case: + (let ([val-list (caar val-list+outputs)]) + (if (equal? val-list (list (void))) + null + (map (lambda (v) + (list (make-flow (list (make-paragraph + (list + (hspace 2) + (elem #:style result-color + (to-element/no-color v #:expr? (print-as-expression))))))))) + val-list)))]) (loop (cdr expr-paras) (cdr val-list+outputs) #f))))))) @@ -159,7 +164,21 @@ (get-output ev) (get-error-output ev)))]) (list (let ([v (do-plain-eval ev s #t)]) - (make-reader-graph (copy-value v (make-hasheq)))) + (if (call-in-sandbox-context + ev + (let ([cp (current-print)]) + (lambda () + (and (eq? (current-print) cp) + (print-as-expression))))) + (make-reader-graph (copy-value v (make-hasheq))) + (box + (call-in-sandbox-context + ev + (lambda () + (let ([s (open-output-string)]) + (parameterize ([current-output-port s]) + (map (current-print) v)) + (get-output-string s))))))) (get-output ev) (get-error-output ev)))]) (when expect diff --git a/collects/scribblings/scribble/eval.scrbl b/collects/scribblings/scribble/eval.scrbl index 4c50f071..0bc1aca0 100644 --- a/collects/scribblings/scribble/eval.scrbl +++ b/collects/scribblings/scribble/eval.scrbl @@ -25,12 +25,24 @@ set to @racket['string]. If @racket[eval] is not provided, an evaluator is created using @racket[make-base-eval]. See also @racket[make-eval-factory]. +If the value of @racket[current-print] in the sandbox is changed from +its default value, or if @racket[print-as-expression] in the sandbox +is set to @racket[#f], then each evaluation result is formatted to a +string by applying @racket[(current-print)] to the value (with the +output port set to a string port). Otherwise, result values are +typeset using @racket[to-element/no-color]. + Uses of @racket[code:comment] and @racketidfont{code:blank} are stipped from each @racket[datum] before evaluation. If a @racket[datum] has the form @racket[(@#,indexed-racket[eval:alts] #,(svar show-datum) #,(svar eval-datum))], then @svar[show-datum] is -typeset, while @svar[eval-datum] is evaluated.} +typeset, while @svar[eval-datum] is evaluated. + +If a @racket[datum] has the form +@racket[(@#,indexed-racket[eval:check] #,(svar eval-datum) #,(svar +expect-datum))], then both @svar[eval-datum] and @svar[check-datum] +are evaluated, and an error is raised if they are not @racket[equal?].} @defform*[[(interaction-eval datum) @@ -90,8 +102,8 @@ prompt, and with line of space after it.} @defproc[(make-base-eval) (any/c . -> . any)]{ Creates an evaluator using @racket[(make-evaluator 'racket/base)], -setting sandbox parameters to disable limits, set the outputs to -@racket['string], and not add extra security guards.} +setting sandbox parameters to disable limits, setting the outputs to +@racket['string], and not adding extra security guards.} @defproc[(make-base-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{ @@ -105,7 +117,7 @@ time) and then attached to each evaluator that is created.} @defproc[(make-eval-factory [mod-paths (listof module-path?)]) (-> (any/c . -> . any))]{ -Like @racket[make-base-eval-factor], but each module in @racket[mod-paths] is +Like @racket[make-base-eval-factory], but each module in @racket[mod-paths] is also required into the top-level environment for each generated evaluator.}