From 40637616ad28a55c218f01c6261c875420793329 Mon Sep 17 00:00:00 2001 From: Matthias Felleisen Date: Fri, 22 Jul 2011 10:34:00 -0400 Subject: [PATCH] fixed a totally misleading error message in big-bang; MUST GO INTO RELEASE (cherry picked from commit ed7f16c872987a6aead663452abc4a7ebbbc059b) --- collects/2htdp/tests/on-tick-defined.rkt | 13 +++++++++++-- collects/2htdp/universe.rkt | 8 ++++---- 2 files changed, 15 insertions(+), 6 deletions(-) diff --git a/collects/2htdp/tests/on-tick-defined.rkt b/collects/2htdp/tests/on-tick-defined.rkt index bec034fb80..f210c16be7 100644 --- a/collects/2htdp/tests/on-tick-defined.rkt +++ b/collects/2htdp/tests/on-tick-defined.rkt @@ -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) diff --git a/collects/2htdp/universe.rkt b/collects/2htdp/universe.rkt index 7d382c7049..bffdf4e22e 100644 --- a/collects/2htdp/universe.rkt +++ b/collects/2htdp/universe.rkt @@ -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 ...))])