From 6fe864319495105fb54244b7683ee7d9a6c9f797 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 27 Dec 2010 09:15:23 -0600 Subject: [PATCH] adjust teaching languages so that print works properly --- collects/lang/htdp-langs.rkt | 23 ++++++++----- collects/tests/drracket/language-test.rkt | 40 +++++++++++++---------- 2 files changed, 38 insertions(+), 25 deletions(-) diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt index efdd2aae32..719712085f 100644 --- a/collects/lang/htdp-langs.rkt +++ b/collects/lang/htdp-langs.rkt @@ -159,18 +159,25 @@ ;; hack: the test-engine code knows about the test~object name; we do, too (namespace-set-variable-value! 'test~object (build-test-engine)) ;; record signature violations with the test engine - (signature-violation-proc - (lambda (obj signature message blame) - (cond - ((namespace-variable-value 'test~object #f (lambda () #f)) - => (lambda (engine) - (send (send engine get-info) signature-failed - obj signature message blame)))))) + (signature-violation-proc + (lambda (obj signature message blame) + (cond + ((namespace-variable-value 'test~object #f (lambda () #f)) + => (lambda (engine) + (send (send engine get-info) signature-failed + obj signature message blame)))))) (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%)) (test-execute (get-preference 'tests:enable? (lambda () #t))) (signature-checking-enabled? (get-preference 'signatures:enable-checking? (lambda () #t))) (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))))) - (super on-execute settings run-in-user-thread)) + (super on-execute settings run-in-user-thread) + + ;; set the global-port-print-handler after the super class because the super sets it too + (run-in-user-thread + (lambda () + (global-port-print-handler + (λ (value port [depth 0]) + (teaching-language-render-value/format value settings port 'infinity)))))) (define/private (teaching-languages-error-value->string settings v len) (let ([sp (open-output-string)]) diff --git a/collects/tests/drracket/language-test.rkt b/collects/tests/drracket/language-test.rkt index 2f2fcafea9..6db1b383cc 100644 --- a/collects/tests/drracket/language-test.rkt +++ b/collects/tests/drracket/language-test.rkt @@ -119,6 +119,7 @@ the settings above should match r5rs (test-expression "+1/2i" "0+1/2i") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" "1.0") (test-expression "(let ([f (lambda (x) x)]) f)" "#") (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") @@ -218,6 +219,7 @@ the settings above should match r5rs (test-expression "+1/2i" "0+1/2i") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" "1.0") (test-expression "(let ([f (lambda (x) x)]) f)" "#") (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") @@ -323,6 +325,7 @@ the settings above should match r5rs (test-expression "+1/2i" "0+1/2i") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "(exact? 1.5)" "#f") + (test-expression "(print (floor (sqrt 2)))" #rx"reference to undefined identifier: print") (test-expression "(let ((f (lambda (x) x))) f)" "#") (test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") @@ -477,9 +480,10 @@ the settings above should match r5rs (test-expression "779625/32258" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" - "true" - "true") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" + "print: name is not defined, not a parameter, and not a primitive name" + "reference to an identifier before its definition: print") (test-expression "(let ([f (lambda (x) x)]) f)" "let: name is not defined, not a parameter, and not a primitive name" @@ -643,9 +647,10 @@ the settings above should match r5rs (test-expression "779625/32258" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" - "true" - "true") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" + "print: name is not defined, not a parameter, and not a primitive name" + "reference to an identifier before its definition: print") (test-expression "(let ([f (lambda (x) x)]) f)" "let: name is not defined, not a parameter, and not a primitive name" @@ -803,9 +808,10 @@ the settings above should match r5rs (test-expression "779625/32258" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" - "true" - "true") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" + "print: name is not defined, not a parameter, and not a primitive name" + "reference to an identifier before its definition: print") (test-expression "(let ([f (lambda (x) x)]) f)" "function:f" @@ -960,9 +966,10 @@ the settings above should match r5rs (test-expression "779625/32258" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" - "true" - "true") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" + "print: name is not defined, not a parameter, and not a primitive name" + "reference to an identifier before its definition: print") (test-expression "(let ([f (lambda (x) x)]) f)" "(lambda (a1) ...)" @@ -1119,9 +1126,8 @@ the settings above should match r5rs (test-expression "779625/32258" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") - (test-expression "(exact? 1.5)" - "true" - "true") + (test-expression "(exact? 1.5)" "true") + (test-expression "(print (floor (sqrt 2)))" "#i1.0") (test-expression "(let ([f (lambda (x) x)]) f)" "(lambda (a1) ...)" @@ -1492,12 +1498,12 @@ the settings above should match r5rs (define (run-test) (go module-lang) + (go pretty-big) (go r5rs) (go beginner) (go beginner/abbrev) (go intermediate) (go intermediate/lambda) - (go advanced) - (go pretty-big)) + (go advanced)) (fire-up-drscheme-and-run-tests run-test)