racket/collects/2htdp/tests/on-tick-defined.rkt
2010-04-27 16:50:15 -06:00

60 lines
2.1 KiB
Racket

#lang scheme/load
;; purpose: when on-tick or on-xxx has been redefined,
;; --- raise more specific error message
;; (why am I running this in scheme/load for the namespace in eval)
(error-print-source-location #f)
(define legal "~a: not a legal clause in a world description")
(define double
(string-append (format legal 'on-tick) ", on-tick has been redefined"))
(with-handlers ((exn:fail:syntax?
(lambda (x)
(unless (string=? (exn-message x) double) (raise x)))))
(eval '(module a scheme
(require 2htdp/universe)
(local ((define (run) (big-bang 0 (on-tick on-tick)))
(define (on-tick t) 0))
10))))
;; purpose: catch illegal shapes of the form (kwd . stuff)
(with-handlers ((exn:fail:syntax?
(lambda (e)
(unless (string=? (exn-message e) (format legal 'on-tic))
(raise e)))))
(eval '(module a scheme
(require 2htdp/universe)
(big-bang 0 (on-tic add1)))))
;; purpose: catch illegal atomic clauses
(with-handlers ((exn:fail:syntax?
(lambda (e)
(unless (string=? (exn-message e) (format legal 'stop-when))
(raise e)))))
(eval '(module a scheme
(require 2htdp/universe)
(big-bang 0 (on-tick add1) stop-when))))
;; -----------------------------------------------------------------------------
;; purpose: catch illegal big-bang use w/o world expression
(with-handlers ((exn:fail:syntax?
(lambda (x)
(unless (string=? (exn-message x) "big-bang: missing initial state")
(raise x)))))
(eval '(module a scheme
(require 2htdp/universe)
(big-bang (on-key add1)))))
(with-handlers ((exn:fail:syntax?
(lambda (x)
(unless (string=? (exn-message x) "universe: missing initial state")
(raise x)))))
(eval '(module a scheme
(require 2htdp/universe)
(universe (on-msg sub1) (on-new add1)))))