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

improved fix, Matthew's suggestion

Browse Source 
please merge into 6.1.1
This commit is contained in:
Matthias Felleisen 2014-10-21 12:09:25 -04:00
parent 22d9e36150
commit 923a785867
2 changed files with 51 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/htdp-pkgs/htdp-lib/2htdp/private/define-keywords.rkt
View File

@ -29,8 +29,7 @@
(provide kw ...)
(define-syntaxes (kw ...)
(values
(lambda (x)
(raise-syntax-error (if (equal? 'kw x) 'kw 'kw-alt) "used out of context" x))
(lambda (x) 'kw (raise-syntax-error #f "used out of context" x))
...))
;; a macro for creating functions that instantiate the proper object
@ -49,10 +48,3 @@
(lambda #,(args para*)
(lambda ()
(new % #,@(body para*)))))))]))))]))
#;
(define-keywords
new-world
'()
define-create
(on-draw to-draw DEFAULT #'#f values))

52
pkgs/htdp-pkgs/htdp-test/2htdp/tests/error-to-draw.rkt
View File

@ -16,6 +16,52 @@
(namespace-anchor->namespace an))
(error 'to-draw "got no error message"))
;; known problem with the solution:
;; (to-draw on-draw)
;; will signal the wrong kind of error
(with-handlers ([exn:fail:syntax?
;; succeed quietly if
(lambda (x)
(unless (regexp-match? "^to-draw" (exn-message x))
(error 'to-draw "got wrong error message: ~e" (exn-message x))))])
(eval
'(module test racket
(require 2htdp/universe)
(to-draw on-draw))
(namespace-anchor->namespace an))
(error 'to-draw "got no error message"))
(with-handlers ([exn:fail:syntax?
;; succeed quietly if
(lambda (x)
(unless (regexp-match? "^to-draw" (exn-message x))
(error 'to-draw "got wrong error message: ~e" (exn-message x))))])
(eval
'(module test racket
(require 2htdp/universe)
(big-bang 0 (on-draw to-draw)))
(namespace-anchor->namespace an))
(error 'to-draw "got no error message"))
;; it still works okay for on-draw
(with-handlers ([exn:fail:syntax?
;; succeed quietly if
(lambda (x)
(unless (regexp-match? "^on-draw" (exn-message x))
(error 'on-draw "got wrong error message: ~e" (exn-message x))))])
(eval
'(module test racket
(require 2htdp/universe)
(on-draw to-draw))
(namespace-anchor->namespace an))
(error 'on-draw "got no error message"))
(with-handlers ([exn:fail:syntax?
;; succeed quietly if
(lambda (x)
(unless (regexp-match? "^on-draw" (exn-message x))
(error 'on-draw "got wrong error message: ~e" (exn-message x))))])
(eval
'(module test racket
(require 2htdp/universe)
(big-bang 0 (to-draw on-draw)))
(namespace-anchor->namespace an))
(error 'to-draw "got no error message"))