From 3662aee60bac144079d74dcef004c180c5122d82 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 1 Jul 2012 09:24:35 -0600
Subject: [PATCH] *SL: fix `check-expect' syntax checking

Bug introduced during error-message conversion.
---
 collects/htdp/error.rkt               | 2 +-
 collects/test-engine/racket-tests.rkt | 2 +-
 collects/tests/htdp-lang/beg-adv.rktl | 4 ++++
 3 files changed, 6 insertions(+), 2 deletions(-)

diff --git a/collects/htdp/error.rkt b/collects/htdp/error.rkt
index b07cce9016..777ff2bf4c 100644
--- a/collects/htdp/error.rkt
+++ b/collects/htdp/error.rkt
@@ -36,7 +36,7 @@
 ;; check-arity : sym num (list-of TST) -> void
 (define (check-arity name arg# args)
   (unless (= (length args) arg#)
-    (tp-error name (argcount-error-message arg# (length args)))))
+    (tp-error name (argcount-error-message #f arg# (length args)))))
 
 ;; check-proc : sym (... *->* ...) num (union sym str) (union sym str) -> void
 (define (check-proc name f exp-arity arg# arg-err)
diff --git a/collects/test-engine/racket-tests.rkt b/collects/test-engine/racket-tests.rkt
index 8ec25d9647..a40e80b36f 100644
--- a/collects/test-engine/racket-tests.rkt
+++ b/collects/test-engine/racket-tests.rkt
@@ -141,7 +141,7 @@
 
 (define-for-syntax (argcount-error-message/stx arity stx [at-least #f])
   (define ls (syntax->list stx))
-  (argcount-error-message arity (if ls (sub1 (length ls)) 0) at-least))
+  (argcount-error-message #f arity (if ls (sub1 (length ls)) 0) at-least))
 
 ;; check-expect
 (define-syntax (check-expect stx)
diff --git a/collects/tests/htdp-lang/beg-adv.rktl b/collects/tests/htdp-lang/beg-adv.rktl
index 2c89111628..a3be217b03 100644
--- a/collects/tests/htdp-lang/beg-adv.rktl
+++ b/collects/tests/htdp-lang/beg-adv.rktl
@@ -269,6 +269,10 @@
 (htdp-test 1 'ok-dots (if true 1 ...))
 (htdp-error-test #'(set! ... true))
 
+(htdp-top (check-expect 1))
+(htdp-syntax-test #'1 "check-expect: expects 2 arguments, but found only 1")
+(htdp-top-pop 1)
+
 (htdp-syntax-test #'(cons (check-expect 1 1) empty))
 (htdp-syntax-test #'(define (f x) (check-expect 1 x)))
 (htdp-syntax-test #'(define (f x) (check-expect 1 x) x))