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

fixed a totally misleading error message in big-bang; MUST GO INTO RELEASE

Browse Source 
(cherry picked from commit ed7f16c872)
This commit is contained in:
Matthias Felleisen 2011-07-22 10:34:00 -04:00 committed by Eli Barzilay
parent cbd7e37cfc
commit 40637616ad
2 changed files with 15 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/2htdp/tests/on-tick-defined.rkt
View File

@ -7,8 +7,17 @@
(error-print-source-location #f)
(define legal "big-bang: ~a clauses are not allowed when using big-bang")
(define double
"big-bang: the on-tick clause appears twice")
(define double "big-bang: the on-tick clause appears twice")
(define atleast "big-bang: expects a [to-draw handler] clause, missing")
;; is the mandatort to-draw clause specified
(with-handlers ((exn:fail:syntax?
(lambda (x)
(unless (string=? (exn-message x) atleast) (raise x)))))
(eval '(module a scheme
(require 2htdp/universe)
(local ((define (run) (big-bang 0 (on-tick add1))))
10))))
(with-handlers ((exn:fail:syntax?
(lambda (x)

8
collects/2htdp/universe.rkt
View File

@ -218,7 +218,7 @@
"wheel-down"))
(define-syntax (big-bang stx)
(define world0 "expects an expression for the initial world and at least one clause, but nothing's there")
(define world0 "expects an expression for the initial world and at least one clause")
(syntax-case stx ()
[(big-bang) (raise-syntax-error #f world0 stx)]
[(big-bang w clause ...)
@ -234,7 +234,7 @@
[dom (syntax->list #'(clause ...))])
(cond
[(and (not (contains-clause? #'to-draw dom)) (not (contains-clause? #'on-draw dom)))
(raise-syntax-error #f "expects at least one clause after the initial world, but nothing's there" stx)]
(raise-syntax-error #f "expects a [to-draw handler] clause, missing" stx)]
[else
(stepper-syntax-property
#`(run-it ((new-world (if #,rec? aworld% world%)) w #,@args))
@ -314,8 +314,8 @@
(define-syntax (universe stx)
(syntax-case stx ()
[(universe) (raise-syntax-error #f "expects an expression for the initial world and at least one clause, but nothing's there" stx)]
[(universe u) (raise-syntax-error #f "expects at least one clause after the initial world, but nothing's there" stx)]
[(universe) (raise-syntax-error #f "expects an expression for the initial world" stx)]
[(universe u) (raise-syntax-error #f "expects at least an on-new and an on-msg clause after the initial world" stx)]
[(universe u bind ...)
(let* ([args (->args 'universe stx #'u #'(bind ...) UniSpec void)]
[dom (syntax->list #'(bind ...))])