made it easier to check the content of run-time error messages

svn: r1494

collects/tests/mzscheme/beg-adv.ss

@@ -95,7 +95,8 @@
 (htdp-test 19 'cond (cond [(zero? 10) 0] [else 19]))
 
 (htdp-err/rt-test (cond [#f 10]) exn:fail?) ;; Should it be a different exception?
-(htdp-err/rt-test (cond [1 10]))
+(define rx:not-true-or-false "not true or false")
+(htdp-err/rt-test (cond [1 10]) rx:not-true-or-false)
 
 (htdp-syntax-test #'if)
 (htdp-syntax-test #'(if))
@@ -103,22 +104,22 @@
 (htdp-syntax-test #'(if #t 1))
 (htdp-syntax-test #'(if #t 1 2 3))
 
-(htdp-err/rt-test (if 1 2 3))
+(htdp-err/rt-test (if 1 2 3) rx:not-true-or-false)
 
 (htdp-syntax-test #'and)
 (htdp-syntax-test #'(and))
 (htdp-syntax-test #'(and #t))
 
-(htdp-err/rt-test (and 1 #t))
-(htdp-err/rt-test (and #t 1))
+(htdp-err/rt-test (and 1 #t) rx:not-true-or-false)
+(htdp-err/rt-test (and #t 1) rx:not-true-or-false)
 (htdp-test #f 'ok-and (and #t #f 1))
 
 (htdp-syntax-test #'or)
 (htdp-syntax-test #'(or))
 (htdp-syntax-test #'(or #t))
 
-(htdp-err/rt-test (or 1 #f))
-(htdp-err/rt-test (or #f 1))
+(htdp-err/rt-test (or 1 #f) rx:not-true-or-false)
+(htdp-err/rt-test (or #f 1) rx:not-true-or-false)
 (htdp-test #t 'ok-or (or #f #t 1))
 
 (htdp-test #t 'empty? (empty? empty))

collects/tests/mzscheme/beginner.ss

@@ -1,6 +1,7 @@
 
 ;; Basic checks for the beginner language. Error messages really
-;; should be inspected manually.
+;; should be inspected manually, but there's some support for
+;; automatic checking.
 
 ;; Limitations of this test suite:
 ;;  - It doesn't check reader-level parameterization, such as use of quotes
@@ -13,6 +14,40 @@
 ;; See also htdp-image.ss, which must be loaded into MrEd (but is in this
 ;; directory anyway)
 
+;; Tests that apply to all languages go in beg-adv.ss.
+;; Tests that apply only to beginner through intermediate go in beg-intm.ss,
+;;  and so on.
+
+;; Writing tests:
+;;  
+;;   (htdp-test <expected> <name> <expr>)
+;;     checks a run-time result; <expected> is
+;;     an expression evaluated at the top level,
+;;     and <expr> is put into a module and evaluated;
+;;     <name> is usually a symbol, and it is used only for
+;;     naming the test in output
+;;
+;;   (htdp-err/rt-test <expr>)
+;;   (htdp-err/rt-test <expr> <exn-predicate>)
+;;   (htdp-err/rt-test <expr> <message-rx-string>)
+;;     checks for a run-time error by putting <expr> into a
+;;     module and evaluting; if <exn-predicate> is supplied, the
+;;     predicate must produce #t for the resulting exception;
+;;     if <message-rx-string> is supplied, the exception
+;;     message string must match the regexp
+;;
+;;   (htdp-syntax-test #'<expr>)
+;;   (htdp-syntax-test #'<expr> <message-rx-string>)
+;;     check for a syntax error, putting <expr> into a module;
+;;     if <message-rs-string> is supplied, the syntax error
+;;     message must match the regexp
+;;
+;;   (htdp-top <expr>)
+;;     imperatively adds an expression to be included into
+;;     test modules
+;;   (htdp-top-pop <n>)
+;;     removes the last <n> added expressions
+;;
 
 (load-relative "loadtest.ss")
 

collects/tests/mzscheme/htdp-test.ss

@@ -26,17 +26,22 @@
     [(_ expect f . args)
      #'(do-htdp-test #'(test expect f . args) #f #f)]))
 
+(define (htdp-string-to-pred exn?/rx)
+  (if (string? exn?/rx)
+      (lambda (x)
+	(regexp-match exn?/rx (exn-message x)))
+      exn?/rx))
+
 (define-syntax (htdp-err/rt-test stx)
   (syntax-case stx ()
     [(_ expr)
      #'(do-htdp-test #'expr #f exn:application:type?)]
     [(_ expr exn?)
-     #'(do-htdp-test #'expr #f exn?)]))
+     #'(do-htdp-test #'expr #f (htdp-string-to-pred exn?))]))
 
 (define (htdp-error-test stx)
   (do-htdp-test stx #t #f))
 
-
 (module helper mzscheme
   (define-syntax (module-begin stx)
     (syntax-case stx ()