From f300ba967a2e1d8cb4997164ec3e4ca6dbf5cb7d Mon Sep 17 00:00:00 2001 From: Kathy Gray Date: Fri, 18 Sep 2009 14:19:50 +0000 Subject: [PATCH] Changed syntax of check-member-of so that it will work in htdp-beginner Updated docs to reflect this svn: r16065 --- collects/scribblings/htdp-langs/advanced.scrbl | 2 +- collects/scribblings/htdp-langs/beginner-abbr.scrbl | 2 +- collects/scribblings/htdp-langs/beginner.scrbl | 4 ++-- .../htdp-langs/intermediate-lambda.scrbl | 2 +- collects/scribblings/htdp-langs/intermediate.scrbl | 2 +- collects/test-engine/scheme-tests.ss | 13 ++++++------- collects/test-engine/test-display.scm | 7 ++++--- collects/test-engine/test-engine.scrbl | 7 +++---- collects/tests/profj/TestEngineTest.ss | 6 +++--- 9 files changed, 22 insertions(+), 23 deletions(-) diff --git a/collects/scribblings/htdp-langs/advanced.scrbl b/collects/scribblings/htdp-langs/advanced.scrbl index 886fa09b2d..031921194f 100644 --- a/collects/scribblings/htdp-langs/advanced.scrbl +++ b/collects/scribblings/htdp-langs/advanced.scrbl @@ -344,7 +344,7 @@ The same as Intermediate's @|intm-time|.} @defform[(check-expect expr expr)] @defform[(check-within expr expr expr)] @defform[(check-error expr expr)] -@defform[(check-member-of expr expr)] +@defform[(check-member-of expr expr expr ...)] @defform[(check-range expr expr expr)] )]{ diff --git a/collects/scribblings/htdp-langs/beginner-abbr.scrbl b/collects/scribblings/htdp-langs/beginner-abbr.scrbl index 5e45ad25df..ea85f52994 100644 --- a/collects/scribblings/htdp-langs/beginner-abbr.scrbl +++ b/collects/scribblings/htdp-langs/beginner-abbr.scrbl @@ -172,7 +172,7 @@ The same as Beginning's @|beg-and| and @|beg-or|.} @defform[(check-expect expr expr)] @defform[(check-within expr expr expr)] @defform[(check-error expr expr)] -@defform[(check-member-of expr expr)] +@defform[(check-member-of expr expr expr ...)] @defform[(check-range expr expr expr)] )]{ diff --git a/collects/scribblings/htdp-langs/beginner.scrbl b/collects/scribblings/htdp-langs/beginner.scrbl index 6e551a5983..42e3abd989 100644 --- a/collects/scribblings/htdp-langs/beginner.scrbl +++ b/collects/scribblings/htdp-langs/beginner.scrbl @@ -243,10 +243,10 @@ 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].} -@defform[(check-member-of expr expr)]{ +@defform[(check-member-of expr expr expr ...)]{ A test case to check that the first @scheme[expr] produces an element -in the list of the second @scheme[expr].} +that is equivalent to one of the following @scheme[expr]s.} @defform[(check-range expr expr expr)]{ diff --git a/collects/scribblings/htdp-langs/intermediate-lambda.scrbl b/collects/scribblings/htdp-langs/intermediate-lambda.scrbl index d1f30c6a0b..422428036d 100644 --- a/collects/scribblings/htdp-langs/intermediate-lambda.scrbl +++ b/collects/scribblings/htdp-langs/intermediate-lambda.scrbl @@ -178,7 +178,7 @@ The same as Intermediate's @|intm-time|.} @defform[(check-expect expr expr)] @defform[(check-within expr expr expr)] @defform[(check-error expr expr)] -@defform[(check-member-of expr expr)] +@defform[(check-member-of expr expr expr ...)] @defform[(check-range expr expr expr)] )]{ diff --git a/collects/scribblings/htdp-langs/intermediate.scrbl b/collects/scribblings/htdp-langs/intermediate.scrbl index 37d9145f70..3b4b5f3749 100644 --- a/collects/scribblings/htdp-langs/intermediate.scrbl +++ b/collects/scribblings/htdp-langs/intermediate.scrbl @@ -217,7 +217,7 @@ The same as Beginning's @|beg-and| and @|beg-or|.} @defform[(check-expect expr expr)] @defform[(check-within expr expr expr)] @defform[(check-error expr expr)] -@defform[(check-member-of expr expr)] +@defform[(check-member-of expr expr expr ...)] @defform[(check-range expr expr expr)] )]{ diff --git a/collects/test-engine/scheme-tests.ss b/collects/test-engine/scheme-tests.ss index 165137d70a..dabe0ee492 100644 --- a/collects/test-engine/scheme-tests.ss +++ b/collects/test-engine/scheme-tests.ss @@ -51,7 +51,7 @@ (define-for-syntax CHECK-WITHIN-STR "check-within requires three expressions. Try (check-within test expected range).") (define-for-syntax CHECK-MEMBER-OF-STR - "check-member-of requires two expressions. Try (check-member-of test options).") + "check-member-of requires at least two expressions. Try (check-member-of test option options ...).") (define-for-syntax CHECK-RANGE-STR "chech-range requires three expressions. Try (check-range test min max).") @@ -223,19 +223,18 @@ (unless (check-context?) (raise-syntax-error 'check-member-of CHECK-EXPECT-DEFN-STR stx)) (syntax-case stx () - [(_ test actuals) - (check-expect-maker stx #'check-member-of-values-expected #`test (list #`actuals) + [(_ test actual actuals ...) + (check-expect-maker stx #'check-member-of-values-expected #`test (list #`actual #`(list actuals ...)) 'comes-from-check-member-of)] [_ (raise-syntax-error 'check-member-of CHECK-MEMBER-OF-STR stx)])) ;; check-member-of-values-expected: (-> scheme-val) scheme-val src test-object -> void -(define (check-member-of-values-expected test actuals src test-info) - (error-check (lambda (v) (list? v)) actuals LIST-FMT #t) - (error-check (lambda (v) (not (procedure? v))) actuals CHECK-MEMBER-OF-FUNCTION-FMT #f) +(define (check-member-of-values-expected test first-actual actuals src test-info) + (error-check (lambda (v) (not (procedure? v))) first-actual CHECK-MEMBER-OF-FUNCTION-FMT #f) (send (send test-info get-info) add-check) (run-and-check (lambda (v2 v1 _) (memf (lambda (i) (beginner-equal? v1 i)) v2)) (lambda (src format v1 v2 _) (make-not-mem src format v1 v2)) - test actuals #f src test-info 'check-member-of)) + test (cons first-actual actuals) #f src test-info 'check-member-of)) ;;check-range (define-syntax (check-range stx) diff --git a/collects/test-engine/test-display.scm b/collects/test-engine/test-display.scm index e77d5b84ad..ae1c077078 100644 --- a/collects/test-engine/test-display.scm +++ b/collects/test-engine/test-display.scm @@ -258,9 +258,10 @@ [(message-error? fail) (for-each print-formatted (message-error-strings fail))] [(not-mem? fail) - (print "Actual value ~F differs from all given members in ~F." - (formatter (not-mem-test fail)) - (formatter (not-mem-set fail)))] + (print "Actual value ~F differs from all given members in " + (formatter (not-mem-test fail))) + (for-each (lambda (a) (print " ~F" (formatter a))) (not-mem-set fail)) + (print ".")] [(not-range? fail) (print "Actual value ~F is not between ~F and ~F, inclusive." (formatter (not-range-test fail)) diff --git a/collects/test-engine/test-engine.scrbl b/collects/test-engine/test-engine.scrbl index 4dde83851c..b9de23e2d9 100644 --- a/collects/test-engine/test-engine.scrbl +++ b/collects/test-engine/test-engine.scrbl @@ -46,11 +46,10 @@ It is an error to produce a function value.} Checks that evaluating the first expression signals an error, where the error message matches the string.} -@defform[(check-member-of (test any/c) (expecteds (listof any/c)))]{ +@defform[(check-member-of (test any/c) (expected any/c) ...)]{ -Accepts two value-producing expressions, where the second expression -must evaluate to a list of values. Structurally compares the first -value to each value in the list. +Accepts at least two value-producing expressions. Structurally compares the first +value to each value subsequent value specified. It is an error to produce a function value.} diff --git a/collects/tests/profj/TestEngineTest.ss b/collects/tests/profj/TestEngineTest.ss index 170d71979c..c9db8df40e 100644 --- a/collects/tests/profj/TestEngineTest.ss +++ b/collects/tests/profj/TestEngineTest.ss @@ -43,9 +43,9 @@ (check-error 3 "some message") ;fails (check-error (first empty) "another message") ;fails -(check-member-of (make-ball 1 1 'blue) (list (make-ball 1 2 'blue) (make-ball 1 1 'blue) (make-ball 1 2 'red) 'red)) -(check-member-of 1 (list 1 1 1 1)) -(check-member-of (make-ball 2 2 'blue) (list (make-ball 1 2 'blue) (make-ball 1 1 'blue) (make-ball 1 2 'red) 'red)) ;fails +(check-member-of (make-ball 1 1 'blue) (make-ball 1 2 'blue) (make-ball 1 1 'blue) (make-ball 1 2 'red) 'red) +(check-member-of 1 1 1 1 1) +(check-member-of (make-ball 2 2 'blue) (make-ball 1 2 'blue) (make-ball 1 1 'blue) (make-ball 1 2 'red) 'red) ;fails (check-range 5 0 10) (check-range 0 0 10)