Closing pr11216. Adding one armed check-error to teaching languages.

[It will not bother me if we revert this commit. I liked SK's idea and found it easy to implement. I wonder if others will be worried that it is easy to unintentionally leave off the second argument to check-error. I also wonder if it is problematic to add new string constants, like I've done.]

Here is an example:

(check-error (/ 1 0) "/: division by zero")
(check-error (/ 1 0) "divide by zero")
(check-error (/ 1 0))
(check-error 1)

Here is the output:

Ran 4 tests.
2 of the 4 tests failed.

No signature violations.

Check failures:
	check-error encountered the following error instead of the expected divide by zero
   :: /: division by zero
in ex.rkt, line 2, column 0
	check-error expected an error, but instead received the value 1.
in ex.rkt, line 4, column 0

collects/scribblings/htdp-langs/advanced.scrbl

@@ -408,7 +408,8 @@ The same as Intermediate's @|intm-time|.}
 @deftogether[(
 @defform[(check-expect expr expr)]
 @defform[(check-within expr expr expr)]
-@defform[(check-error expr expr)]
+@defform*[[(check-error expr expr)
+           (check-error expr)]]
 @defform[(check-member-of expr expr expr ...)]
 @defform[(check-range expr expr expr)]
 )]{

collects/scribblings/htdp-langs/beginner-abbr.scrbl

@@ -171,7 +171,8 @@ The same as Beginning's @|beg-and| and @|beg-or|.}
 @deftogether[(
 @defform[(check-expect expr expr)]
 @defform[(check-within expr expr expr)]
-@defform[(check-error expr expr)]
+@defform*[[(check-error expr expr)
+           (check-error expr)]]
 @defform[(check-member-of expr expr expr ...)]
 @defform[(check-range expr expr expr)]
 )]{

collects/scribblings/htdp-langs/beginner.scrbl

@@ -237,11 +237,12 @@ a number @scheme[_delta]. The test case checks that each number in the
 result of the first @scheme[expr] is within @scheme[_delta] of each
 corresponding number from the second @scheme[expr].}
 
-@defform[(check-error expr expr)]{
+@defform*[[(check-error expr expr)
+           (check-error expr)]]{
 
 A test case to check that the first @scheme[expr] signals an error,
 where the error messages matches the string produced by the second
-@scheme[expr].}
+@scheme[expr], if it is present.}
 
 @defform[(check-member-of expr expr expr ...)]{
 

collects/scribblings/htdp-langs/intermediate-lambda.scrbl

@@ -177,7 +177,8 @@ The same as Intermediate's @|intm-time|.}
 @deftogether[(
 @defform[(check-expect expr expr)]
 @defform[(check-within expr expr expr)]
-@defform[(check-error expr expr)]
+@defform*[[(check-error expr expr)
+           (check-error expr)]]
 @defform[(check-member-of expr expr expr ...)]
 @defform[(check-range expr expr expr)]
 )]{

collects/scribblings/htdp-langs/intermediate.scrbl

@@ -223,7 +223,8 @@ The same as Beginning's @|beg-and| and @|beg-or|.}
 @deftogether[(
 @defform[(check-expect expr expr)]
 @defform[(check-within expr expr expr)]
-@defform[(check-error expr expr)]
+@defform*[[(check-error expr expr)
+           (check-error expr)]]
 @defform[(check-member-of expr expr expr ...)]
 @defform[(check-range expr expr expr)]
 )]{

collects/scribblings/htdp-langs/std-grammar.rkt

@@ -21,7 +21,8 @@
               @#,scheme[(check-within expr expr expr)]
 	      @#,scheme[(check-member-of expr expr (... ...))]
 	      @#,scheme[(check-range expr expr expr)]
-              @#,scheme[(check-error expr expr)]]
+              @#,scheme[(check-error expr expr)]
+              @#,scheme[(check-error expr)]]
    (...
     [library-require @#,scheme[(require string)]
                      @#,scheme[(require (lib string string ...))]

collects/string-constants/english-string-constants.rkt

@@ -1439,6 +1439,8 @@ please adhere to these guidelines:
    "check-error encountered the following error instead of the expected ~a~n   :: ~a")
   (test-engine-expected-error-error
    "check-error expected the following error, but instead received the value ~F.~n ~a")
+  (test-engine-expected-an-error-error
+   "check-error expected an error, but instead received the value ~F.")
   ;; members are appended to the message
   (test-engine-not-mem-error "Actual value ~F differs from all given members in ")
   (test-engine-not-range-error "Actual value ~F is not between ~F and ~F, inclusive.")

collects/test-engine/racket-tests.rkt

@@ -16,7 +16,7 @@
  check-within ;; syntax : (check-within <expression> <expression> <expression>)
  check-member-of ;; syntax : (check-member-of <expression> <expression>)
  check-range ;; syntax : (check-range <expression> <expression> <expression>)
- check-error  ;; syntax : (check-error <expression> <expression>)
+ check-error  ;; syntax : (check-error <expression> [<expression>])
  )
 
 ; for other modules implementing check-expect-like forms
@@ -48,7 +48,7 @@
 (define-for-syntax CHECK-EXPECT-STR
   "check-expect requires two expressions. Try (check-expect test expected).")
 (define-for-syntax CHECK-ERROR-STR
-  "check-error requires two expressions. Try (check-error test message).")
+  "check-error requires at least one expression. Try (check-error test message) or (check-error test).")
 (define-for-syntax CHECK-WITHIN-STR
   "check-within requires three expressions. Try (check-within test expected range).")
 (define-for-syntax CHECK-MEMBER-OF-STR
@@ -191,6 +191,9 @@
     [(_ test error)
      (check-expect-maker stx #'check-values-error #`test (list #`error)
                          'comes-from-check-error)]
+    [(_ test)
+     (check-expect-maker stx #'check-values-error/no-string #`test null
+                         'comes-from-check-error)]
     [_ (raise-syntax-error 'check-error CHECK-ERROR-STR stx)]))
 
 ;; check-values-error: (-> scheme-val) scheme-val src test-object -> void
@@ -212,6 +215,21 @@
           #f)
         #t)))
 
+;; check-values-error/no-string: (-> scheme-val) src test-object -> void
+(define (check-values-error/no-string test src test-info)
+  (send (send test-info get-info) add-check)
+  (let ([result (with-handlers ([exn?
+                                 (lambda (e) #t)])
+                  (let ([test-val (test)])
+                    (make-expected-an-error src (test-format) test-val)))])
+    (if (check-fail? result)
+        (begin
+          (send (send test-info get-info) check-failed
+                result (check-fail-src result)
+                #f)
+          #f)
+        #t)))
+
 
 ;;error-check: (scheme-val -> boolean) format-string boolean) -> void : raise exn:fail:contract
 (define (error-check pred? actual fmt fmt-act?)

collects/test-engine/test-display.scm

@@ -278,6 +278,9 @@
 	  (print (string-constant test-engine-expected-error-error)
 		 (formatter (expected-error-value fail))
 		 (expected-error-message fail))]
+         [(expected-an-error? fail)
+	  (print (string-constant test-engine-expected-an-error-error)
+		 (formatter (expected-an-error-value fail)))]
 	 [(message-error? fail)
 	  (for-each print-formatted (message-error-strings fail))]
          [(not-mem? fail)

collects/test-engine/test-engine.scrbl

@@ -41,10 +41,11 @@ delta of the cooresponding number in the second expression.
 It is an error to produce a function value.}
 
 
-@defproc[(check-error (test any/c) (msg string?)) void?]{
+@defproc*[([(check-error (test any/c) (msg string?)) void?]
+           [(check-error (test any/c)) void?])]{
 
 Checks that evaluating the first expression signals an error, where
-the error message matches the string.}
+the error message matches the string, if it is present.}
 
 @defform[(check-member-of (test any/c) (expected any/c) ...)]{
 

collects/test-engine/test-info.scm

@@ -21,6 +21,8 @@
 (define-struct (incorrect-error check-fail) (expected message exn))
 ;; (make-expected-error src format string scheme-val)
 (define-struct (expected-error check-fail) (message value))
+;; (make-expected-an-error src format scheme-val)
+(define-struct (expected-an-error check-fail) (value))
 ;; (make-not-mem src format scheme-val scheme-val)
 (define-struct (not-mem check-fail) (test set))
 ;; (make-not-range src format scheme-val scheme-val scheme-val)

collects/tests/htdp-lang/beg-adv.rktl

@@ -278,6 +278,14 @@
 (htdp-test 2 'two 2)
 (htdp-top-pop 1)
 
+(htdp-top (check-error (/ 1 0)))
+(htdp-test 2 'two 2)
+(htdp-top-pop 1)
+
+(htdp-top (check-error 1))
+(htdp-test 2 'two 2)
+(htdp-top-pop 1)
+
 (htdp-top (check-error (/ 1 0) "wrong error"))
 (htdp-test 2 'two 2)
 (htdp-top-pop 1)