adjust teaching languages so that print works properly

This commit is contained in:
Robby Findler 2010-12-27 09:15:23 -06:00
parent 413c0489f2
commit 6fe8643194
2 changed files with 38 additions and 25 deletions

View File

@ -159,18 +159,25 @@
;; hack: the test-engine code knows about the test~object name; we do, too ;; hack: the test-engine code knows about the test~object name; we do, too
(namespace-set-variable-value! 'test~object (build-test-engine)) (namespace-set-variable-value! 'test~object (build-test-engine))
;; record signature violations with the test engine ;; record signature violations with the test engine
(signature-violation-proc (signature-violation-proc
(lambda (obj signature message blame) (lambda (obj signature message blame)
(cond (cond
((namespace-variable-value 'test~object #f (lambda () #f)) ((namespace-variable-value 'test~object #f (lambda () #f))
=> (lambda (engine) => (lambda (engine)
(send (send engine get-info) signature-failed (send (send engine get-info) signature-failed
obj signature message blame)))))) obj signature message blame))))))
(scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%)) (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
(test-execute (get-preference 'tests:enable? (lambda () #t))) (test-execute (get-preference 'tests:enable? (lambda () #t)))
(signature-checking-enabled? (get-preference 'signatures:enable-checking? (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))))))) (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) (define/private (teaching-languages-error-value->string settings v len)
(let ([sp (open-output-string)]) (let ([sp (open-output-string)])

View File

@ -119,6 +119,7 @@ the settings above should match r5rs
(test-expression "+1/2i" "0+1/2i") (test-expression "+1/2i" "0+1/2i")
(test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}")
(test-expression "(exact? 1.5)" "#f") (test-expression "(exact? 1.5)" "#f")
(test-expression "(print (floor (sqrt 2)))" "1.0")
(test-expression "(let ([f (lambda (x) x)]) f)" "#<procedure:f>") (test-expression "(let ([f (lambda (x) x)]) f)" "#<procedure:f>")
(test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") (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 "+1/2i" "0+1/2i")
(test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}")
(test-expression "(exact? 1.5)" "#f") (test-expression "(exact? 1.5)" "#f")
(test-expression "(print (floor (sqrt 2)))" "1.0")
(test-expression "(let ([f (lambda (x) x)]) f)" "#<procedure:f>") (test-expression "(let ([f (lambda (x) x)]) f)" "#<procedure:f>")
(test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") (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 "+1/2i" "0+1/2i")
(test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}") (test-expression "779625/32258" "{number 779625/32258 \"24 5433/32258\" mixed}")
(test-expression "(exact? 1.5)" "#f") (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)" "#<procedure:f>") (test-expression "(let ((f (lambda (x) x))) f)" "#<procedure:f>")
(test-expression ",1" "{stop-22x22.png} unquote: not in quasiquote in: (unquote 1)") (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" (test-expression "779625/32258"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}")
(test-expression "(exact? 1.5)" (test-expression "(exact? 1.5)" "true")
"true" (test-expression "(print (floor (sqrt 2)))"
"true") "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)" (test-expression "(let ([f (lambda (x) x)]) f)"
"let: name is not defined, not a parameter, and not a primitive name" "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" (test-expression "779625/32258"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}")
(test-expression "(exact? 1.5)" (test-expression "(exact? 1.5)" "true")
"true" (test-expression "(print (floor (sqrt 2)))"
"true") "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)" (test-expression "(let ([f (lambda (x) x)]) f)"
"let: name is not defined, not a parameter, and not a primitive name" "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" (test-expression "779625/32258"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}")
(test-expression "(exact? 1.5)" (test-expression "(exact? 1.5)" "true")
"true" (test-expression "(print (floor (sqrt 2)))"
"true") "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)" (test-expression "(let ([f (lambda (x) x)]) f)"
"function:f" "function:f"
@ -960,9 +966,10 @@ the settings above should match r5rs
(test-expression "779625/32258" (test-expression "779625/32258"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}")
(test-expression "(exact? 1.5)" (test-expression "(exact? 1.5)" "true")
"true" (test-expression "(print (floor (sqrt 2)))"
"true") "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)" (test-expression "(let ([f (lambda (x) x)]) f)"
"(lambda (a1) ...)" "(lambda (a1) ...)"
@ -1119,9 +1126,8 @@ the settings above should match r5rs
(test-expression "779625/32258" (test-expression "779625/32258"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}" "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}"
"{number 779625/32258 \"24.1684233368466736933473866...\" decimal}") "{number 779625/32258 \"24.1684233368466736933473866...\" decimal}")
(test-expression "(exact? 1.5)" (test-expression "(exact? 1.5)" "true")
"true" (test-expression "(print (floor (sqrt 2)))" "#i1.0")
"true")
(test-expression "(let ([f (lambda (x) x)]) f)" (test-expression "(let ([f (lambda (x) x)]) f)"
"(lambda (a1) ...)" "(lambda (a1) ...)"
@ -1492,12 +1498,12 @@ the settings above should match r5rs
(define (run-test) (define (run-test)
(go module-lang) (go module-lang)
(go pretty-big)
(go r5rs) (go r5rs)
(go beginner) (go beginner)
(go beginner/abbrev) (go beginner/abbrev)
(go intermediate) (go intermediate)
(go intermediate/lambda) (go intermediate/lambda)
(go advanced) (go advanced))
(go pretty-big))
(fire-up-drscheme-and-run-tests run-test) (fire-up-drscheme-and-run-tests run-test)