suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

improved the implementation of error in the teaching languages, added test casees

Browse Source 
svn: r17923
This commit is contained in:
Robby Findler 2010-02-01 15:39:33 +00:00
parent bf67e34e87
commit 6f4c164793
4 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/lang/private/beginner-funs.ss
View File

@ -468,7 +468,7 @@
("Misc"
(identity (any -> any)
"to return the argument unchanged")
((beginner-error error) (any ... -> void) "to signal an error, turning the given values into an error message ")
((beginner-error error) (any ... -> void) "to signal an error, combining the given values into an error message.\n\nIf any of the values' printed representations is too long, it is truncated and ``...'' is put into the string. If the first value is a symbol, it is treated specially; it is suffixed with a colon and a space (the intention is that the symbol is the name of the function signalling the error).")
((beginner-struct? struct?) (any -> boolean)
"to determine whether some value is a structure")
((beginner-equal? equal?) (any any -> boolean)

28
collects/lang/private/teachprims.ss
View File

@ -2,7 +2,7 @@
collects/tests/mzscheme/beginner.ss
.../beginner-abbr.ss
.../intermediate.ss
.../intermediate-lam.ss
.../intermediate-lambda.ss
.../advanced.ss
Each one has to run separately, since they mangle the top-level
@ -197,25 +197,13 @@ namespace.
(if (and (cons? stuff0) (symbol? (first stuff0)))
(values (first stuff0) (rest stuff0))
(values false stuff0)))
(define str
(let loop ([stuff stuff1][frmt ""][pieces '()])
(cond
[(empty? stuff) (apply format frmt (reverse pieces))]
[else
(let ([f (first stuff)]
[r (rest stuff)])
(if (string? f)
(loop r (string-append frmt f) pieces)
(loop r (string-append frmt "~e") (cons f pieces))))])))
(if f (error f str) (error str)))
#;
(lambda (str)
(unless (string? str)
(raise
(make-exn:fail:contract
(format "error: expected a string, got ~e and ~e" str)
(current-continuation-marks))))
(error str)))
(error (apply
string-append
(if f (format "~a: " f) "")
(for/list ([ele (in-list stuff1)])
(if (string? ele)
ele
(format "~e" ele)))))))
(define-teach beginner struct?
(lambda (x)

9
collects/tests/mzscheme/beg-adv.ss
View File

@ -387,6 +387,15 @@
(htdp-test false 'string-lower-case? (string-lower-case? "ab\t"))
(htdp-test true 'string-lower-case? (string-lower-case? "abc"))
(htdp-err/rt-test (error "a" "a") #rx"^aa$")
(htdp-err/rt-test (error 'a "a") #rx"^a: a$")
(htdp-err/rt-test (error "This is" " an err" "or" " message with a number: " 5)
#rx"^This is an error message with a number: 5$")
(htdp-err/rt-test (error "several numbers " 1 2 3 4 5 6 7)
#rx"^several numbers 1234567$")
(htdp-err/rt-test (error "several numbers " 1 " 2 " 3 " 4")
#rx"^several numbers 1 2 3 4$")
(htdp-top (require scheme/match))
(htdp-test 17 'match (match 'x ['x 17]))
(htdp-test 'x 'match (match 'x ['y 17][z z]))

2
collects/tests/mzscheme/htdp-test.ss
View File

@ -94,7 +94,7 @@
#'(void)]))
(define (htdp-string-to-pred exn?/rx)
(if (string? exn?/rx)
(if (or (regexp? exn?/rx) (string? exn?/rx))
(lambda (x)
(regexp-match exn?/rx (exn-message x)))
exn?/rx))