*SL: fix `check-expect' syntax checking

Bug introduced during error-message conversion.
This commit is contained in:
Matthew Flatt 2012-07-01 09:24:35 -06:00
parent c69ea5569f
commit 3662aee60b
3 changed files with 6 additions and 2 deletions

View File

@ -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)

View File

@ -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)

View File

@ -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))