From 3023c89787f07a3a399729a8d8ffb6c44786441b Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Thu, 3 Oct 2013 14:01:48 -0400 Subject: [PATCH 1/2] fix scribble make-base-eval pretty-printing bug closes PR 14066 --- pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt | 41 ++++++++++----------- 1 file changed, 19 insertions(+), 22 deletions(-) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt index 6ec781b..691b90b 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/eval.rkt @@ -336,30 +336,29 @@ [(eq? stx 'code:blank) (void)] [else stx])) -(define (install-pretty-printer! e ns) - (call-in-sandbox-context e - (lambda () - (namespace-attach-module ns 'racket/pretty) - (current-print (dynamic-require 'racket/pretty 'pretty-print-handler))))) - (define (make-base-eval #:lang [lang '(begin)] #:pretty-print? [pretty-print? #t] . ips) (call-with-trusted-sandbox-configuration (lambda () (parameterize ([sandbox-output 'string] [sandbox-error-output 'string] - [sandbox-propagate-breaks #f]) + [sandbox-propagate-breaks #f] + [sandbox-namespace-specs + (cons (λ () (namespace-anchor->namespace anchor)) + (if pretty-print? + '(racket/pretty file/convertible) + '(file/convertible)))]) (let ([e (apply make-evaluator lang ips)]) - (let ([ns (namespace-anchor->namespace anchor)]) - (call-in-sandbox-context - e - (lambda () (namespace-attach-module ns 'file/convertible))) - (when pretty-print? (install-pretty-printer! e ns))) + (when pretty-print? + (call-in-sandbox-context e + (lambda () + (current-print (dynamic-require 'racket/pretty 'pretty-print-handler))))) e))))) (define (make-base-eval-factory mod-paths #:lang [lang '(begin)] #:pretty-print? [pretty-print? #t] . ips) - (let ([ns (delay (let ([ns + (parameterize ([sandbox-namespace-specs + (cons (λ () (let ([ns ;; This namespace-creation choice needs to be consistent ;; with the sandbox (i.e., with `make-base-eval') (if gui? @@ -369,16 +368,14 @@ (for ([mod-path (in-list mod-paths)]) (dynamic-require mod-path #f)) (when pretty-print? (dynamic-require 'racket/pretty #f))) - ns))]) + ns)) + (append mod-paths (if pretty-print? '(racket/pretty) '())))]) (lambda () - (let ([ev (apply make-base-eval #:lang lang #:pretty-print? #f ips)] - [ns (force ns)]) - (when pretty-print? (install-pretty-printer! ev ns)) - (call-in-sandbox-context - ev - (lambda () - (for ([mod-path (in-list mod-paths)]) - (namespace-attach-module ns mod-path)))) + (let ([ev (apply make-base-eval #:lang lang #:pretty-print? #f ips)]) + (when pretty-print? + (call-in-sandbox-context ev + (lambda () + (current-print (dynamic-require 'racket/pretty 'pretty-print-handler))))) ev)))) (define (make-eval-factory mod-paths -- 1.7.9.5 From 02467640eafecbab0e64719bbd5fadafa062cee9 Mon Sep 17 00:00:00 2001 From: Stephen Chang Date: Thu, 3 Oct 2013 14:06:56 -0400 Subject: [PATCH 2/2] add tests for scribble/eval --- .../scribble-test/tests/scribble/eval.rkt | 58 ++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 pkgs/scribble-pkgs/scribble-test/tests/scribble/eval.rkt diff --git a/pkgs/scribble-pkgs/scribble-test/tests/scribble/eval.rkt b/pkgs/scribble-pkgs/scribble-test/tests/scribble/eval.rkt new file mode 100644 index 0000000..5b09434 --- /dev/null +++ b/pkgs/scribble-pkgs/scribble-test/tests/scribble/eval.rkt @@ -0,0 +1,58 @@ +#lang racket/base +(require scribble/eval scribble/core rackunit racket/match) + +(check-not-exn (λ () (make-base-eval))) +(check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'racket/base))) +(check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'racket))) +(check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'typed/racket))) +(check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'lazy))) + +(check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t)))) +(check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'racket/base)))) +(check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'racket)))) +(check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'typed/racket)))) +(check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'lazy)))) + +(check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t)))) +(check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'racket/base)))) +(check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'racket)))) +(check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'typed/racket)))) +(check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'lazy)))) + +(define (get-result-blocks nf) + (match (nested-flow-blocks nf) [(list (table _ (list _ res))) res])) + +(define filter-datum '(define (filter p? lst) + (if (null? lst) + null + (let ([x (car lst)]) + (if (p? x) + (cons x (filter p? (cdr lst))) + (filte p? (cdr lst))))))) +;; check that pretty printing is working +(define pp-blocks + (car + (get-result-blocks + (interaction #:eval (make-base-eval #:pretty-print? #t #:lang 'racket) + '(define (filter p? lst) + (if (null? lst) + null + (let ([x (car lst)]) + (if (p? x) + (cons x (filter p? (cdr lst))) + (filter p? (cdr lst)))))))))) +(check-true (table? pp-blocks)) ; multiple line result gets put in a table of paragraphs +(check-equal? (length (table-blockss pp-blocks)) 5) ;; pretty printed into 5 lines + +(define non-pp-blocks + (car + (get-result-blocks + (interaction #:eval (make-base-eval #:pretty-print? #f #:lang 'racket) + '(define (filter p? lst) + (if (null? lst) + null + (let ([x (car lst)]) + (if (p? x) + (cons x (filter p? (cdr lst))) + (filter p? (cdr lst)))))))))) +(check-true (paragraph? non-pp-blocks)) ;; single line result is just 1 paragraph -- 1.7.9.5