eval.rkt (3614B)
1 #lang racket/base 2 (require scribble/eval scribble/core rackunit racket/match) 3 4 (check-not-exn (λ () (make-base-eval))) 5 (check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'racket/base))) 6 (check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'racket))) 7 (check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'typed/racket))) 8 (check-not-exn (λ () (make-base-eval #:pretty-print? #t #:lang 'lazy))) 9 (check-not-exn (λ () (make-base-eval #:pretty-print? #f #:lang 'racket/base))) 10 (check-not-exn (λ () (make-base-eval #:pretty-print? #f #:lang 'racket))) 11 (check-not-exn (λ () (make-base-eval #:pretty-print? #f #:lang 'typed/racket))) 12 (check-not-exn (λ () (make-base-eval #:pretty-print? #f #:lang 'lazy))) 13 14 (check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t)))) 15 (check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'racket/base)))) 16 (check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'racket)))) 17 (check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'typed/racket)))) 18 (check-not-exn (λ () ((make-base-eval-factory '() #:pretty-print? #t #:lang 'lazy)))) 19 20 (check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t)))) 21 (check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'racket/base)))) 22 (check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'racket)))) 23 (check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'typed/racket)))) 24 (check-not-exn (λ () ((make-eval-factory '() #:pretty-print? #t #:lang 'lazy)))) 25 26 (define (get-result-blocks nf) 27 (match (nested-flow-blocks nf) [(list (table _ (list _ res))) res])) 28 29 (define filter-datum '(define (filter p? lst) 30 (if (null? lst) 31 null 32 (let ([x (car lst)]) 33 (if (p? x) 34 (cons x (filter p? (cdr lst))) 35 (filte p? (cdr lst))))))) 36 ;; check that pretty printing is working 37 (define pp-blocks 38 (car 39 (get-result-blocks 40 (interaction #:eval (make-base-eval #:pretty-print? #t #:lang 'racket) 41 '(define (filter p? lst) 42 (if (null? lst) 43 null 44 (let ([x (car lst)]) 45 (if (p? x) 46 (cons x (filter p? (cdr lst))) 47 (filter p? (cdr lst)))))))))) 48 (check-true (table? pp-blocks)) ; multiple line result gets put in a table of paragraphs 49 (check-equal? (length (table-blockss pp-blocks)) 5) ;; pretty printed into 5 lines 50 51 (define non-pp-blocks 52 (car 53 (get-result-blocks 54 (interaction #:eval (make-base-eval #:pretty-print? #f #:lang 'racket) 55 '(define (filter p? lst) 56 (if (null? lst) 57 null 58 (let ([x (car lst)]) 59 (if (p? x) 60 (cons x (filter p? (cdr lst))) 61 (filter p? (cdr lst)))))))))) 62 (check-true (paragraph? non-pp-blocks)) ;; single line result is just 1 paragraph 63 64 ;; check that different evaluators do not share a single namespace 65 (define e1 (make-base-eval)) 66 (define e2 (make-base-eval)) 67 (check-exn exn:fail:contract:variable? (λ () (e1 '(current-date)))) 68 (check-exn exn:fail:contract:variable? (λ () (e2 '(current-date)))) 69 (e1 '(require racket/date)) 70 (check-not-exn (λ () (e1 '(current-date)))) 71 (check-exn exn:fail:contract:variable? (λ () (e2 '(current-date))))