suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Updated the error message of check-expect. Fine tuning of the error messages.

Browse Source
This commit is contained in:
Guillaume Marceau 2011-07-03 05:14:25 -04:00
parent eedab060ba
commit aa9dbd21f5
20 changed files with 204 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/lang/htdp-advanced.rkt
View File

@ -1,11 +1,10 @@
(module htdp-advanced scheme/base
(require "private/teach.rkt"
"private/teachprims.rkt"
"private/teach-module-begin.rkt"
mzlib/etc
mzlib/list
mzlib/pretty
syntax/docprovide
(require "private/teach.ss"
"private/teach-module-begin.ss"
mzlib/etc
mzlib/list
mzlib/pretty
syntax/docprovide
scheme/promise
test-engine/scheme-tests
"posn.rkt")
@ -35,6 +34,8 @@
[beginner-dots ....]
[beginner-dots .....]
[beginner-dots ......]
[beginner-true true]
[beginner-false false]
[intermediate-quote quote]
[intermediate-quasiquote quasiquote]
[intermediate-unquote unquote]
@ -49,8 +50,7 @@
[advanced-case case]
[advanced-match match]
[advanced-delay delay]
[advanced-module-begin #%module-begin]
)
[advanced-module-begin #%module-begin])
check-expect
check-within
check-error
@ -58,7 +58,7 @@
check-range
#%datum
#%top-interaction
empty true false
empty
signature : -> mixed one-of predicate combined
Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any

11
collects/lang/htdp-beginner-abbr.rkt
View File

@ -6,9 +6,8 @@
test-engine/scheme-tests)
;; Implements the forms:
(require "private/teach.rkt"
"private/teachprims.rkt"
"private/teach-module-begin.rkt")
(require "private/teach.ss"
"private/teach-module-begin.ss")
;; syntax:
(provide (rename-out
@ -32,7 +31,9 @@
[intermediate-quasiquote quasiquote]
[intermediate-unquote unquote]
[intermediate-unquote-splicing unquote-splicing]
[beginner-module-begin #%module-begin])
[beginner-module-begin #%module-begin]
[beginner-true true]
[beginner-false false])
check-expect
check-within
check-error
@ -40,7 +41,7 @@
check-range
#%datum
#%top-interaction
empty true false
empty
; signature : -> mixed one-of predicate combined
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any

7
collects/lang/htdp-beginner.rkt
View File

@ -35,6 +35,8 @@
[beginner-dots ....]
[beginner-dots .....]
[beginner-dots ......]
[beginner-true true]
[beginner-false false]
)
check-expect
check-within
@ -44,7 +46,7 @@
;; define-wish
#%datum
#%top-interaction
empty true false
empty
; signature : -> mixed one-of predicate combined
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any
@ -55,6 +57,7 @@
(require (for-syntax "private/firstorder.ss"))
(define-syntax (in-rator-position-only stx)
(syntax-case stx ()
[(_ new-name orig-name)
@ -73,7 +76,7 @@
(raise-syntax-error
#f
(format
"found a use that does not follow an open parenthesis")
"expected a function call, but there is no open parenthesis before this function")
stx)]))
#'orig-name))))]))

4
collects/lang/htdp-intermediate-lambda.rkt
View File

@ -36,6 +36,8 @@
[intermediate-unquote-splicing unquote-splicing]
[intermediate-time time]
[intermediate-module-begin #%module-begin]
[beginner-true true]
[beginner-false false]
)
check-expect
check-within
@ -44,7 +46,7 @@
check-range
#%datum
#%top-interaction
empty true false
empty
; signature : -> mixed one-of predicate combined
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any

4
collects/lang/htdp-intermediate.rkt
View File

@ -38,6 +38,8 @@
[intermediate-unquote-splicing unquote-splicing]
[intermediate-time time]
[intermediate-module-begin #%module-begin]
[beginner-true true]
[beginner-false false]
)
check-expect
check-within
@ -46,7 +48,7 @@
check-range
#%datum
#%top-interaction
empty true false
empty
; signature : -> mixed one-of predicate combined
; Number Real Rational Integer Natural Boolean True False String Symbol Char Empty-list Any

4
collects/lang/prim.rkt
View File

@ -44,7 +44,7 @@
[_
(raise-syntax-error
#f
"found a use that does not follow an open parenthesis"
"expected a function call, but there is no open parenthesis before this function"
stx)])))
((syntax-local-certifier #t)
#'impl))))]))
@ -122,7 +122,7 @@
[_
(raise-syntax-error
#f
"found a use that does not follow an open parenthesis"
"expected a function call, but there is no open parenthesis before this function"
s)])))
((syntax-local-certifier #t)
#'impl))))))))]))

57
collects/lang/private/rewrite-error-message.rkt
View File

@ -22,8 +22,12 @@
(define (exn-needs-rewriting? exn)
(exn:fail:contract? exn))
(define (ensure-number n-or-str)
(if (string? n-or-str) (string->number n-or-str) n-or-str))
(define (plural n)
(if (> (string->number n) 1) "s" ""))
(if (> (ensure-number n) 1) "s" ""))
(define (raise-not-bound-error id)
(if (syntax-property id 'was-in-app-position)
@ -36,30 +40,51 @@
"this variable is not defined"
id)))
(define (argcount-error-message arity found)
(define fn-is-large (> (string->number arity) (string->number found)))
(format "expects ~a~a argument~a, but found ~a~a"
(if fn-is-large "" "only ")
arity (plural arity)
(if fn-is-large "only " "")
found))
(define (argcount-error-message arity found [at-least #f])
(define arity:n (ensure-number arity))
(define found:n (ensure-number found))
(define fn-is-large (> arity:n found:n))
(format "expects ~a~a~a argument~a, but found ~a~a"
(if at-least "at least " "")
(if (or (= arity:n 0) fn-is-large) "" "only ")
(if (= arity:n 0) "no" arity:n) (plural arity:n)
(if (and (not (= found:n 0)) fn-is-large) "only " "")
(if (= found:n 0) "none" found:n)))
(define (rewrite-contract-error-message msg)
(define replacements
(list (list #rx"expects argument of type (<([^>]+)>)"
(list (list #rx"procedure application: expected procedure, given: (.*) \\(no arguments\\)"
(lambda (all one)
(format "function call: expected a function after the open parenthesis, but received ~a" one)))
(list #rx"procedure application: expected procedure, given: (.*); arguments were:.*"
(lambda (all one)
(format "function call: expected a function after the open parenthesis, but received ~a" one)))
(list #rx"expects argument of type (<([^>]+)>)"
(lambda (all one two) (format "expects a ~a" two)))
(list #rx"expected argument of type (<([^>]+)>)"
(lambda (all one two) (format "expects a ~a" two)))
(list #rx"expects type (<([^>]+)>)"
(lambda (all one two) (format "expects a ~a" two)))
(list #px"expects at least (\\d+) argument.?, given (\\d+): .*"
(lambda (all one two) (format "expects at least ~a argument~a, but found only ~a."
one (plural one) two)))
(list #px"expects (\\d+) argument.?, given (\\d+): .*"
(lambda (all one two) (argcount-error-message one two)))
(list #px"expects at least (\\d+) argument.?, given (\\d+)(: .*)?"
(lambda (all one two three) (argcount-error-message one two #t)))
(list #px"expects (\\d+) argument.?, given (\\d+)(: .*)?"
(lambda (all one two three) (argcount-error-message one two)))
(list #rx"^procedure "
(lambda (all) ""))
))
(list #rx", given: "
(lambda (all) ", given "))
(list #rx"; other arguments were:.*"
(lambda (all) ""))
(list #rx"expects a (struct:)"
(lambda (all one) "expects a "))
(list #rx"list or cyclic list"
(lambda (all) "list"))
(list (regexp-quote "#(struct:object:image-snip% ...)")
(lambda (all) "an image"))
(list (regexp-quote "#(struct:object:cache-image-snip% ...)")
(lambda (all) "an image"))))
(for/fold ([msg msg]) ([repl. replacements])
(regexp-replace* (first repl.) msg (second repl.))))
(regexp-replace* (first repl.) msg (second repl.))))
(define (get-rewriten-error-message exn)
(if (exn-needs-rewriting? exn)

85
collects/lang/private/teach.rkt
View File

@ -59,6 +59,7 @@
(require-for-syntax "teachhelp.ss"
"rewrite-error-message.rkt"
"teach-shared.ss"
"rewrite-error-message.rkt"
syntax/kerncase
syntax/stx
syntax/struct
@ -76,7 +77,7 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; run-time helpers
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; verify-boolean is inserted to check for boolean results:
(define (verify-boolean b where)
(if (or (eq? b #t) (eq? b #f))
@ -97,17 +98,15 @@
val))
(define undefined (letrec ([x x]) x))
(define (identifier-is-bound? id)
(or (identifier-binding id)
;; identifier-binding returns #f for variable bound at the top-level,
;; check explicitly:
(and (namespace-variable-value (syntax-e id) #t (lambda () #f)) #t)))
;; Wrapped around top-level definitions to disallow re-definition:
(define (check-top-level-not-defined who id)
(when (let ([b (identifier-binding id)])
;; if it's not top-level, raise an exn
(if b
#t
;; At top-level, might be bound to syntax or value:
(with-handlers ([exn:fail:contract:variable? (lambda (exn) #f)]
[exn:fail:syntax? (lambda (exn) #t)])
(namespace-variable-value (syntax-e id) #t)
#t)))
(when (identifier-is-bound? id)
(raise-syntax-error #f "this name was defined previously and cannot be re-defined" id)))
(define (top/check-defined id)
@ -170,6 +169,7 @@
(define provided-identifiers (quote-syntax (id ...)))
defn ...))))])))
;; The implementation of form X is defined below as X/proc. The
;; reason for this is to allow the implementation of Y to re-use the
;; implementation of X (expanding to a use of X would mangle syntax
@ -190,6 +190,8 @@
beginner-quote/expr
beginner-require
beginner-dots
beginner-true
beginner-false
intermediate-define
intermediate-define-struct
@ -263,7 +265,7 @@
name
stx
#f
"found a use that does not follow an open parenthesis"))
"expected an open parenthesis before ~a, but found none" name))
;; Use for messages "expected ..., found <something else>"
(define (something-else v)
@ -272,6 +274,7 @@
[(number? v) "a number"]
[(string? v) "a string"]
[(list? v) "a part"]
[(struct? v) "an image"]
[else "something else"])))
(define (ordinal n)
@ -287,6 +290,7 @@
[(= 3 (modulo n 10))
(format "~ard" n)]))
;; At the top level, wrap `defn' to first check for
;; existing definitions of the `names'. The `names'
;; argument is a syntax list of identifiers.
@ -457,7 +461,28 @@
(values (k names)
names)))
;; Racket's true and false are defined as macros (for performance perhaps?),
;; but this dodge *SL's redefinition of #%app and set!. Without these
;; beginner-true/proc and beginner-false/proc here, (true) would throw a
;; professional error message not suitable for beginners.
(define (make-constant-expander val)
(make-set!-transformer
(lambda (stx)
(syntax-case stx (set!)
[(set! id rhs) (syntax/loc stx (set! val rhs))]
[(id . args)
(teach-syntax-error
'|function call|
#'stx
#'id
"expected a function after the open parenthesis, but found ~a"
(syntax-e #'id))]
[_ (datum->syntax stx val)]))))
(define beginner-true/proc (make-constant-expander #t))
(define beginner-false/proc (make-constant-expander #f))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define (beginner)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -953,9 +978,7 @@
[(self . args)
(raise-syntax-error
#f
(string-append
"cannot use a signature name after an"
" open parenthesis for a function call")
"expected a function after the open parenthesis, but found a structure name"
stx
#'self)]
[_ #'#,signature-name])))
@ -974,7 +997,7 @@
'define-struct
stx
(syntax something)
"expected at least one field name after the structure name, but found ~a"
"expected at least one field name (in parentheses) after the structure name, but found ~a"
(something-else (syntax something)))]
[(_ name_)
(teach-syntax-error
@ -1174,7 +1197,7 @@
(bad-app "a variable")]
[(or lex-ok? (and binding (not (binding-in-this-module? binding))))
(with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)])
(syntax/loc stx (#%app new-rator rand ...)))]
(syntax/loc stx (#%app new-rator rand ...)))]
[else
;; We don't know what rator is, yet, and it might be local:
(with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)])
@ -1183,16 +1206,17 @@
(#%app values #,(quasisyntax/loc
stx
(beginner-app-continue new-rator rand ...)))))]))]
[(_)
[(_)
(teach-syntax-error
'|function call|
stx
#f
(format
"expected a function after the open parenthesis, but nothing's there"))]
[_else (bad-use-error '#%app stx)])))])
"expected a function after the open parenthesis, but nothing's there")]
[_else (bad-use-error '|function call| stx)])))])
(values (mk-app #f) (mk-app #t))))
(define (beginner-app-continue/proc stx)
(syntax-case stx ()
[(_ rator rand ...)
@ -1202,15 +1226,14 @@
;; Now defined in the module:
(if (set!-transformer? (syntax-local-value fun (lambda () #f)))
;; Something that takes care of itself:
(syntax/loc stx (rator rand ...))
(syntax/loc stx (rator rand ...))
;; Something for which we probably need to report an error,
;; but let beginner-app take care of it:
(syntax/loc stx (beginner-app rator rand ...)))
;; Something undefined; let beginner-top take care of it:
(with-syntax ([new-rator (syntax-property #'rator 'was-in-app-position #t)])
(syntax/loc stx (#%app new-rator rand ...)))
))]))
(syntax/loc stx (#%app new-rator rand ...)))))]))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; top-level variables (beginner)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1406,9 +1429,7 @@
where
stx
#f
"expected at least two expressions after ~a, but ~a"
where
(if (zero? n) "nothing's there" "found only one expression")))
(argcount-error-message 2 n #t)))
(let loop ([clauses-consumed 0]
[remaining (syntax->list #`clauses)])
(if (null? remaining)
@ -2294,7 +2315,7 @@
stx
#f
"expected a function after the open parenthesis, but nothing's there")]
[_else (bad-use-error '#%app stx)]))))
[_else (bad-use-error '|function call| stx)]))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; set! (advanced)
@ -2673,11 +2694,11 @@
qqp]))]
[check-and-translate-p
(λ (p)
(syntax-case p (struct posn true false empty intermediate-quote intermediate-quasiquote advanced-cons list advanced-list* vector box)
[true
(syntax-case p (struct posn beginner-true beginner-false empty intermediate-quote intermediate-quasiquote advanced-cons list advanced-list* vector box)
[beginner-true
(syntax/loc p
#t)]
[false
[beginner-false
(syntax/loc p
#f)]
[empty
@ -2775,7 +2796,7 @@
(syntax (unless (cyclic-list? (cdr name))
(raise-type-error
'cons
"list or cyclic list"
"list"
1
(car name)
(cdr name))))))

2
collects/lang/private/teachhelp.rkt
View File

@ -64,7 +64,7 @@
(identifier? #'id)
(raise-syntax-error
#f
(format "found a use that does not follow an open parenthesis")
(format "expected a function call, but there is no open parenthesis before this function")
stx
#f)]
[(id . rest)

18
collects/lang/private/teachprims.rkt
View File

@ -88,15 +88,9 @@ namespace.
(unless (ok? last)
(raise
(make-exn:fail:contract
(format "~a: last argument must be ~a ~a, but received ~e; the other arguments were: ~a"
(format "~a: last argument must be ~a ~a, but received ~e"
prim-name (a-or-an type) type
last
;; all-but-last:
(build-arg-list
(let loop ([args args])
(cond
[(null? (cdr args)) null]
[else (cons (car args) (loop (cdr args)))]))))
last)
(current-continuation-marks)))))]
[else (loop (cdr l))]))))
@ -278,9 +272,9 @@ namespace.
(and (number? b)
(beginner-=~ a b epsilon))]
[(procedure? a)
(fail "first argument of equality cannot be a procedure, given ~e" a)]
(fail "first argument of equality cannot be a function, given ~e" a)]
[(procedure? b)
(fail "second argument of equality cannot be a procedure, given ~e" b)]
(fail "second argument of equality cannot be a function, given ~e" b)]
[(union-equal!? a b) #t]
[else (equal?/recur a b ?)]))))
@ -297,9 +291,9 @@ namespace.
(let recur ([a x] [b y])
(cond
[(procedure? a)
(fail "first argument of equality cannot be a procedure, given ~e" a)]
(fail "first argument of equality cannot be a function, given ~e" a)]
[(procedure? b)
(fail "second argument of equality cannot be a procedure, given ~e" b)]
(fail "second argument of equality cannot be a function, given ~e" b)]
[(and (number? a)
(inexact? a))
(fail "first argument of equality cannot be an inexact number, given ~e" a)]

35
collects/test-engine/racket-tests.rkt
View File

@ -1,6 +1,7 @@
#lang racket
(require lang/private/teachprims
(for-syntax lang/private/rewrite-error-message)
scheme/class
scheme/match
lang/private/continuation-mark-key
@ -30,34 +31,23 @@
(define FUNCTION-FMT
"check-expect cannot compare functions.")
(define CHECK-ERROR-STR-FMT
"check-error requires a string for the second argument, representing the expected error message. Given ~s")
"check-error expects a string for the second argument, representing the expected error message. Given ~s")
(define CHECK-WITHIN-INEXACT-FMT
"check-within requires an inexact number for the range. ~a is not inexact.")
"check-within expects an inexact number for the range. ~a is not inexact.")
(define CHECK-WITHIN-FUNCTION-FMT
"check-within cannot compare functions.")
(define LIST-FMT
"check-member-of requires a list for the second argument, containing the possible outcomes. Given ~s")
"check-member-of expects a list for the second argument, containing the possible outcomes. Given ~s")
(define CHECK-MEMBER-OF-FUNCTION-FMT
"check-member-of cannot compare functions.")
(define RANGE-MIN-FMT
"check-range requires a number for the minimum value. Given ~a")
"check-range expects a number for the minimum value. Given ~a")
(define RANGE-MAX-FMT
"check-range requires a number for the maximum value. Given ~a")
"check-range expects a number for the maximum value. Given ~a")
(define CHECK-RANGE-FUNCTION-FMT
"check-range cannot compare functions.")
(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 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
"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).")
(define-for-syntax CHECK-EXPECT-DEFN-STR
"found a test that is not at the top level")
(define-for-syntax CHECK-WITHIN-DEFN-STR
@ -149,6 +139,9 @@
(let ([c (syntax-local-context)])
(memq c '(module top-level))))
(define-for-syntax (argcount-error-message/stx arity stx [at-least #f])
(argcount-error-message arity (sub1 (length (syntax->list stx))) at-least))
;; check-expect
(define-syntax (check-expect stx)
(unless (check-context?)
@ -157,7 +150,7 @@
[(_ test actual)
(check-expect-maker stx #'check-values-expected #`test (list #`actual)
'comes-from-check-expect)]
[_ (raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)]))
[_ (raise-syntax-error 'check-expect (argcount-error-message/stx 2 stx) stx)]))
;; check-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-values-expected test actual src test-engine)
@ -177,7 +170,7 @@
[(_ test actual within)
(check-expect-maker stx #'check-values-within #`test (list #`actual #`within)
'comes-from-check-within)]
[_ (raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]))
[_ (raise-syntax-error 'check-within (argcount-error-message/stx 3 stx) stx)]))
;; check-values-within: (-> scheme-val) scheme-val number src test-engine -> void
(define (check-values-within test actual within src test-engine)
@ -199,7 +192,7 @@
[(_ 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)]))
[_ (raise-syntax-error 'check-error (argcount-error-message/stx 1 stx #t) stx)]))
;; check-values-error: (-> scheme-val) scheme-val src test-engine -> void
(define (check-values-error test error src test-engine)
@ -250,7 +243,7 @@
[(_ 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)]))
[_ (raise-syntax-error 'check-member-of (argcount-error-message/stx 2 stx #t) stx)]))
;; check-member-of-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-member-of-values-expected test first-actual actuals src test-engine)
@ -268,7 +261,7 @@
[(_ test min max)
(check-expect-maker stx #'check-range-values-expected #`test (list #`min #`max)
'comes-from-check-range)]
[_ (raise-syntax-error 'check-range CHECK-RANGE-STR stx)]))
[_ (raise-syntax-error 'check-range (argcount-error-message/stx 3 stx) stx)]))
;; check-range-values-expected: (-> scheme-val) scheme-val src test-engine -> void
(define (check-range-values-expected test min max src test-engine)

22
collects/tests/drracket/language-test.rkt
View File

@ -422,7 +422,7 @@ the settings above should match r5rs
(test-expression "(cons 1 2)"
"cons: second argument must be a list, but received 1 and 2")
(test-expression "(+ (list 1) 2)"
"+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2")
"+: expects a number as 1st argument, given (cons 1 empty)")
(test-expression "'(1)"
"quote: expected the name of the symbol after the quote, but found a part")
(test-expression "(define shrd (list 1)) (list shrd shrd)"
@ -435,7 +435,7 @@ the settings above should match r5rs
"letrec: this function is not defined"
"function call: expected a function after the open parenthesis, but found a part")
(test-expression "(if 1 1 1)" "if: question result is not true or false: 1")
(test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1")
(test-expression "(+ 1)" "+: expects at least 2 arguments, but found only 1")
(test-expression "1.0" "1" "1")
(test-expression "#i1.0" "#i1.0" "#i1.0")
@ -572,7 +572,7 @@ the settings above should match r5rs
(test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!")
(test-expression "(cond [(= 1 2) 3])" "cond: all question results were false")
(test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)")
(test-expression "'(1)"
"(list 1)"
"(list 1)")
@ -586,7 +586,7 @@ the settings above should match r5rs
"letrec: this function is not defined"
"function call: expected a function after the open parenthesis, but found a part")
(test-expression "(if 1 1 1)" "if: question result is not true or false: 1")
(test-expression "(+ 1)" "+: expects at least 2 arguments, given 1: 1")
(test-expression "(+ 1)" "+: expects at least 2 arguments, but found only 1")
(test-expression "1.0" "1" "1")
(test-expression "#i1.0" "#i1.0" "#i1.0")
@ -722,7 +722,7 @@ the settings above should match r5rs
(test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!")
(test-expression "(cond [(= 1 2) 3])" "cond: all question results were false")
(test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (cons 1 empty); other arguments were: 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)")
(test-expression "'(1)"
"(list 1)"
"(list 1)")
@ -781,7 +781,7 @@ the settings above should match r5rs
(test-expression "(list 1)"
"(list 1)"
"(list 1)")
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "(car (list))" "car: expects a pair; given empty")
(test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")
@ -869,7 +869,7 @@ the settings above should match r5rs
(test-undefined-fn "(define qqq 2) (set! qqq 1)" "set!")
(test-expression "(cond [(= 1 2) 3])" "cond: all question results were false")
(test-expression "(cons 1 2)" "cons: second argument must be a list, but received 1 and 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given: (list 1); other arguments were: 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)")
(test-expression "'(1)"
"(list 1)"
"(list 1)")
@ -924,7 +924,7 @@ the settings above should match r5rs
(test-expression "(list 1)"
"(list 1)"
"(list 1)")
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "(car (list))" "car: expects a pair; given empty")
(test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")
@ -988,7 +988,7 @@ the settings above should match r5rs
|#
(test-undefined-var "class")
(test-expression "shared" "shared: found a use that does not follow an open parenthesis")
(test-expression "shared" "shared: expected an open parenthesis before shared, but found none")
(test-expression "(define (. x y) (* x y))" "read: illegal use of \".\"")
(test-expression "'(1 . 2)" "read: illegal use of \".\"")
@ -1016,7 +1016,7 @@ the settings above should match r5rs
"qqq: this name was defined previously and cannot be re-defined\n(void)")
(test-expression "(cond [(= 1 2) 3])" "cond: all question results were false")
(test-expression "(cons 1 2)" "cons: second argument must be a list or cyclic list, but received 1 and 2")
(test-expression "(+ (list 1) 2)" "+: expects type <number> as 1st argument, given: (list 1); other arguments were: 2")
(test-expression "(+ (list 1) 2)" "+: expects a number as 1st argument, given (list 1)")
(test-expression "'(1)"
"(list 1)"
"(list 1)")
@ -1075,7 +1075,7 @@ the settings above should match r5rs
(test-expression "(list 1)"
"(list 1)"
"(list 1)")
(test-expression "(car (list))" "car: expects argument of type <pair>; given empty")
(test-expression "(car (list))" "car: expects a pair; given empty")
(test-undefined-var "argv")
(test-undefined-fn "(define-syntax app syntax-case)" "define-syntax")

16
collects/tests/drracket/repl-test.rkt
View File

@ -79,7 +79,7 @@ This produces an ACK message
(define test-data
(list
#|
;; basic tests
(mktest "1"
("1"
@ -540,12 +540,12 @@ This produces an ACK message
(mktest "(require lang/htdp-beginner)\n(cond [1 2 3 4])"
("{stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with one question and one answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4")
("{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4"
"{stop-multi.png} {stop-22x22.png} repl-test-tmp3.rkt:2:7: cond: expected a clause with a question and an answer, but found a clause with 4 parts in:\n 1\n 2\n 3\n 4")
'definitions
#f
void
@ -611,7 +611,7 @@ This produces an ACK message
#f
void
void)
|#
;; error escape handler test
(mktest
"(let ([old (error-escape-handler)])\n(+ (let/ec k\n(dynamic-wind\n(lambda () (error-escape-handler (lambda () (k 5))))\n(lambda () (expt 3 #f))\n(lambda () (error-escape-handler old))))\n10))"

24
collects/tests/htdp-lang/advanced.rktl
View File

@ -38,7 +38,7 @@
(define x8 (lambda () 11))
(test 11 x8)
(htdp-syntax-test #'begin "begin: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'begin "begin: expected an open parenthesis before begin, but found none")
(htdp-syntax-test #'(begin) "begin: expected at least one expression after begin, but nothing's there")
(htdp-syntax-test #'(begin (define x 10)) "define: found a definition that is not at the top level")
(htdp-syntax-test #'(begin (define x 10) x) "define: found a definition that is not at the top level")
@ -54,7 +54,7 @@
(htdp-test 12 'begin+set! (begin 12 ex))
(htdp-top-pop 1)
(htdp-syntax-test #'begin0 "begin0: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'begin0 "begin0: expected an open parenthesis before begin0, but found none")
(htdp-syntax-test #'(begin0) "begin: expected at least one expression after begin0, but nothing's there")
(htdp-test 1 'begin0 (begin0 1))
@ -62,7 +62,7 @@
(htdp-test 3 'begin0 (begin0 3 2 1))
(htdp-syntax-test #'set! "set!: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'set! "set!: expected an open parenthesis before set!, but found none")
(htdp-syntax-test #'(set!) "set!: expected a variable after set!, but nothing's there")
(htdp-syntax-test #'(set! x) "set!: expected an expression for the new value, but nothing's there")
(htdp-syntax-test #'(set! 1 2) "set!: expected a variable after set!, but found a number")
@ -87,7 +87,7 @@
x)))
45)
(htdp-syntax-test #'delay "delay: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'delay "delay: expected an open parenthesis before delay, but found none")
(htdp-syntax-test #'(delay) "delay: expected an expression after delay, but nothing's there")
(htdp-syntax-test #'(delay 1 2) "delay: expected only one expression after delay, but found 1 extra part")
@ -114,7 +114,7 @@
(htdp-test 19 'lookup (recur empty-f () 19))
(htdp-syntax-test #'case "case: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'case "case: expected an open parenthesis before case, but found none")
(htdp-syntax-test #'(case) "case: expected an expression after case, but nothing's there")
(htdp-syntax-test #'(case 5) "expected a clause with at least one choice (in parentheses) and an answer after the expression, but nothing's there")
(htdp-syntax-test #'(case 5 12) "case: expected a clause with at least one choice (in parentheses) and an answer, but found a number")
@ -136,7 +136,7 @@
(htdp-test 'd 'case (case 'hello [(no) 10][(6 5 hello) 'd][else 'b]))
(htdp-test 'cc 'case (case (+ 2 3) [(6 5) 'cc][else 'b]))
(htdp-syntax-test #'when "when: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'when "when: expected an open parenthesis before when, but found none")
(htdp-syntax-test #'(when) "when: expected a question and an answer, but nothing's there")
(htdp-syntax-test #'(when 10) "when: expected a question and an answer, but found only one part")
(htdp-syntax-test #'(when 10 12 13) "when: expected a question and an answer, but found 3 parts")
@ -146,7 +146,7 @@
(htdp-test (void) 'when (when false 1))
(htdp-test 11 'when (when true 11))
(htdp-syntax-test #'unless "unless: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'unless "unless: expected an open parenthesis before unless, but found none")
(htdp-syntax-test #'(unless) "unless: expected a question and an answer, but nothing's there")
(htdp-syntax-test #'(unless 10) "unless: expected a question and an answer, but found only one part")
(htdp-syntax-test #'(unless 10 12 13) "unless: expected a question and an answer, but found 3 parts")
@ -156,7 +156,7 @@
(htdp-test (void) 'unless (unless true 1))
(htdp-test 11 'unless (unless false 11))
(htdp-syntax-test #'shared "shared: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'shared "shared: expected an open parenthesis before shared, but found none")
(htdp-syntax-test #'(shared) "shared: expected at least one binding (in parentheses) after shared, but nothing's there")
(htdp-syntax-test #'(shared ()) "shared: expected an expression after the bindings, but nothing's there")
(htdp-syntax-test #'(shared 1 2) "shared: expected at least one binding (in parentheses) after shared, but found a number")
@ -179,7 +179,7 @@
(htdp-test #t (lambda (l) (eq? l (cadr l))) (shared ([x (list x x)]) x))
(htdp-err/rt-test (shared ([x (cons 1 y)][y 5]) x))
(htdp-syntax-test #'recur "recur: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'recur "recur: expected an open parenthesis before recur, but found none")
(htdp-syntax-test #'(recur) "recur: expected a function name after recur, but nothing's there")
(htdp-syntax-test #'(recur 10) "recur: expected a function name after recur, but found a number")
(htdp-syntax-test #'(recur name) "recur: expected at least one binding (in parentheses) after recur, but nothing's there")
@ -198,7 +198,7 @@
(load (build-path (collection-path "tests" "racket") "shared-tests.rktl"))
(htdp-err/rt-test (cons 1 2) "cons: second argument must be a list or cyclic list, but received 1 and 2")
(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2; the other arguments were:")
(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list or cyclic list, but received 2")
(htdp-test #t 'equal? (equal? (vector (list 10) 'apple) (vector (list 10) 'apple)))
(htdp-test #t 'equal? (equal? (shared ([x (cons 10 x)]) x) (shared ([x (cons 10 x)]) x)))
@ -417,7 +417,7 @@
;; define-datatype
(htdp-syntax-test #'define-datatype #rx"define-datatype: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'define-datatype #rx"define-datatype: expected an open parenthesis before define-datatype, but found none")
(htdp-syntax-test #'(define-datatype) #rx"define-datatype: expected a datatype type name after `define-datatype', but nothing's there")
(htdp-syntax-test #'(define-datatype dt 10) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found a number")
(htdp-syntax-test #'(define-datatype dt [v1] 10) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found a number")
@ -460,7 +460,7 @@
;; match
(htdp-syntax-test #'match #rx"match: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'match #rx"match: expected an open parenthesis before match, but found none")
(htdp-syntax-test #'(match) #rx"match: expected an expression after `match', but nothing's there")
(htdp-syntax-test #'(match 1) #rx"match: expected a pattern--answer clause after the expression following `match', but nothing's there")

30
collects/tests/htdp-lang/beg-adv.rktl
View File

@ -5,7 +5,7 @@
(htdp-syntax-test #'quote)
(htdp-syntax-test #'(quote 1 2))
(htdp-syntax-test #'define "define: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'define "define: expected an open parenthesis before define, but found none")
(htdp-syntax-test #'(define) "define: expected a variable name, or a function name and its variables (in parentheses)")
(htdp-syntax-test #'(define x) "define: expected an expression after the variable name")
(htdp-syntax-test #'(define x 10 12) "define: expected only one expression after the variable name")
@ -19,7 +19,7 @@
(htdp-syntax-test #'(define (x y y) 10) "define: found a variable that is used more than once: y")
(htdp-syntax-test #'(define () 10) "define: expected a name for the function, but nothing's there")
(htdp-syntax-test #'(define 1 10) "define: expected a variable name, or a function name and its variables (in parentheses), but found a number")
(htdp-syntax-test #'(define x lambda) "lambda: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'(define x lambda) "lambda: expected an open parenthesis before lambda, but found none")
(htdp-syntax-test #'(define x (lambda)) "lambda: expected at least one variable (in parentheses) after lambda, but nothing's there")
(htdp-syntax-test #'(define x (lambda (x))) "lambda: expected an expression for the function body, but nothing's there")
(htdp-syntax-test #'(define x (lambda y)) "lambda: expected at least one variable (in parentheses) after lambda, but found something else")
@ -41,17 +41,15 @@
(htdp-syntax-test #'(define (y if) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'(define (y and) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'(define (y or) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'(define (y true) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'(define (y false) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'(define (y empty) 12) "define: expected a variable, but found a keyword")
(htdp-syntax-test #'define-struct "define-struct: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'define-struct "define-struct: expected an open parenthesis before define-struct, but found none")
(htdp-syntax-test #'(define-struct) "define-struct: expected the structure name after define-struct, but nothing's there")
(htdp-syntax-test #'(define-struct a) "define-struct: expected at least one field name (in parentheses) after the structure name, but nothing's there")
(htdp-syntax-test #'(define-struct a (b) 10) "define-struct: expected nothing after the field names, but found 1 extra part")
(htdp-syntax-test #'(define-struct a (b) 10 11 12) "define-struct: expected nothing after the field names, but found 3 extra parts")
(htdp-syntax-test #'(define-struct 10 (b)) "define-struct: expected the structure name after define-struct, but found a number")
(htdp-syntax-test #'(define-struct a b) "define-struct: expected at least one field name after the structure name, but found something else")
(htdp-syntax-test #'(define-struct a b) "define-struct: expected at least one field name (in parentheses) after the structure name, but found something else")
(htdp-syntax-test #'(define-struct a (10)) "define-struct: expected a field name, but found a number")
(htdp-syntax-test #'(define-struct a (b 10)) "define-struct: expected a field name, but found a number")
(htdp-syntax-test #'(define-struct (a) (b)) "define-struct: expected the structure name after define-struct, but found a part")
@ -78,9 +76,9 @@
(htdp-test #f 'a1? (a1? (make-a3 1 2 3)))
(htdp-test #f 'a3? (a3? (make-a1 1)))
(htdp-err/rt-test (a1-b 10) "a1-b: expects argument of type <struct:a1>; given 10")
(htdp-syntax-test #'(a0 1 2 3) "a0: cannot use a structure name after an open parenthesis for a function call")
(htdp-syntax-test #'(a0 1 2 3) "a0: expected a function after the open parenthesis, but found a structure name")
(htdp-syntax-test #'cond "cond: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'cond "cond: expected an open parenthesis before cond, but found none")
(htdp-syntax-test #'(cond) "cond: expected a clause after cond, but nothing's there")
(htdp-syntax-test #'(cond 1) "cond: expected a clause with a question and an answer, but found a number")
(htdp-syntax-test #'(cond [#t 6] 2) "cond: expected a clause with a question and an answer, but found a number")
@ -102,7 +100,7 @@
(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 "if: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'if "if: expected an open parenthesis before if, but found none")
(htdp-syntax-test #'(if) "if: expected a question and two answers, but nothing's there")
(htdp-syntax-test #'(if #t) "if: expected a question and two answers, but found only 1 part")
(htdp-syntax-test #'(if #t 1) "if: expected a question and two answers, but found only 2 parts")
@ -110,17 +108,17 @@
(htdp-err/rt-test (if 1 2 3) rx:not-true-or-false)
(htdp-syntax-test #'and "and: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'(and) "and: expected at least two expressions after and, but nothing's there")
(htdp-syntax-test #'(and #t) "and: expected at least two expressions after and, but found only one expression")
(htdp-syntax-test #'and "and: expected an open parenthesis before and, but found none")
(htdp-syntax-test #'(and) "and: expects at least 2 arguments, but found none")
(htdp-syntax-test #'(and #t) "and: expects at least 2 arguments, but found only 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 "or: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'(or) "or: expected at least two expressions after or, but nothing's there")
(htdp-syntax-test #'(or #t) "or: expected at least two expressions after or, but found only one expression")
(htdp-syntax-test #'or "or: expected an open parenthesis before or, but found none")
(htdp-syntax-test #'(or) "or: expects at least 2 arguments, but found none")
(htdp-syntax-test #'(or #t) "or: expects at least 2 arguments, but found only 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)
@ -234,7 +232,7 @@
(htdp-syntax-test #'(define (my-x h) 12) #rx"cannot be re-defined")
(htdp-top-pop 1)
(htdp-top-pop 1)
(htdp-syntax-test #'define #rx"define: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'define #rx"define: expected an open parenthesis before define, but found none")
(htdp-syntax-test #'(require) #rx"found nothing")

14
collects/tests/htdp-lang/beg-bega.rktl
View File

@ -24,7 +24,7 @@
(htdp-top-pop 1)
(htdp-top (define (my-f x) (+ x 5)))
(htdp-syntax-test #'my-f #rx"found a use that does not follow an open parenthesis")
(htdp-syntax-test #'my-f #rx"expected a function call, but there is no open parenthesis before this function")
(htdp-top-pop 1)
;; Teachpacks with higher-order primitives
@ -35,12 +35,12 @@
(htdp-top (define-struct foo (a b)))
(htdp-syntax-test #'(go 5 8) "go: expects a function in this position at: 8 in: (go 5 8)")
(htdp-syntax-test #'(go add1 add1) "add1: found a use that does not follow an open parenthesis in: add1")
(htdp-syntax-test #'(go my-f add1) "my-f: found a use that does not follow an open parenthesis in: my-f")
(htdp-syntax-test #'(go foo? add1) "foo?: found a use that does not follow an open parenthesis in: foo?")
(htdp-syntax-test #'(go make-foo add1) "make-foo: found a use that does not follow an open parenthesis in: make-foo")
(htdp-syntax-test #'(go foo-a add1) "foo-a: found a use that does not follow an open parenthesis in: foo-a")
(htdp-syntax-test #'(go go add1) "go: found a use that does not follow an open parenthesis in: go")
(htdp-syntax-test #'(go add1 add1) "add1: expected a function call, but there is no open parenthesis before this function")
(htdp-syntax-test #'(go my-f add1) "my-f: expected a function call, but there is no open parenthesis before this function")
(htdp-syntax-test #'(go foo? add1) "foo?: expected a function call, but there is no open parenthesis before this function")
(htdp-syntax-test #'(go make-foo add1) "make-foo: expected a function call, but there is no open parenthesis before this function")
(htdp-syntax-test #'(go foo-a add1) "foo-a: expected a function call, but there is no open parenthesis before this function")
(htdp-syntax-test #'(go go add1) "go: expected a function call, but there is no open parenthesis before this function")
(htdp-top-pop 1)
(htdp-teachpack-pop)

2
collects/tests/htdp-lang/beg-intml.rktl
View File

@ -5,4 +5,4 @@
(htdp-syntax-test #'(define xthnk (lambda () 10)) "lambda: expected at least one variable after lambda, but found none")
(htdp-err/rt-test (cons 1 2) "cons: second argument must be a list, but received 1 and 2")
(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list, but received 2; the other arguments were:")
(htdp-err/rt-test (append (list 1) 2) "append: last argument must be a list, but received 2")

2
collects/tests/htdp-lang/bega-adv.rktl
View File

@ -16,7 +16,7 @@
(htdp-test '(quasiquote (unquote 22)) 'qq ``,,(* 11 2))
(htdp-test '(quasiquote ((unquote-splicing (22)))) 'qq ``(,@(,@(list (* 11 2)))))
(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'quasiquote "quasiquote: expected an open parenthesis before quasiquote, but found none")
(htdp-syntax-test #'`unquote "quasiquote: misuse of unquote within a quasiquoting backquote")
(htdp-syntax-test #'`unquote-splicing "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote")
(htdp-syntax-test #'`(unquote-splicing 10) "quasiquote: misuse of ,@ or unquote-splicing within a quasiquoting backquote")

2
collects/tests/htdp-lang/beginner.rktl
View File

@ -91,7 +91,7 @@
(load-relative "beg-intm.rktl")
(load-relative "beg-bega.rktl")
(htdp-syntax-test #'quote "quote: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'quote "quote: expected an open parenthesis before quote, but found none")
(htdp-syntax-test #''1 "quote: expected the name of the symbol after the quote, but found a number")
(htdp-syntax-test #''"hello" "quote: expected the name of the symbol after the quote, but found a string")
(htdp-syntax-test #''(1 2) "quote: expected the name of the symbol after the quote, but found a part")

10
collects/tests/htdp-lang/intm-adv.rktl
View File

@ -2,7 +2,7 @@
;; These are true for beginner, but the operators are syntax, so
;; arity-test doesn't work.
(htdp-syntax-test #'local "local: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'local "local: expected an open parenthesis before local, but found none")
(htdp-syntax-test #'(local) "local: expected at least one definition (in square brackets) after local, but nothing's there")
(htdp-syntax-test #'(local ()) "local: expected an expression after the local definitions, but nothing's there")
(htdp-syntax-test #'(local 1) "local: expected at least one definition (in square brackets) after local, but found a number")
@ -26,7 +26,7 @@
(htdp-test 19 (local [(define (f x) (+ x 10))] f) 9)
(htdp-test 16 'local (local [(define (f x) (+ x 10))] (f 6)))
(htdp-syntax-test #'letrec "letrec: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'letrec "letrec: expected an open parenthesis before letrec, but found none")
(htdp-syntax-test #'(letrec) "letrec: expected at least one binding (in parentheses) after letrec, but nothing's there")
(htdp-syntax-test #'(letrec ()) "letrec: expected an expression after the bindings, but nothing's there")
(htdp-syntax-test #'(letrec 1 2) "letrec: expected at least one binding (in parentheses) after letrec, but found a number")
@ -52,7 +52,7 @@
(htdp-test 19 (letrec ([f (lambda (x) (+ x 10))]) f) 9)
(htdp-test 16 'letrec (letrec ([f (lambda (x) (+ x 10))]) (f 6)))
(htdp-syntax-test #'let "let: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'let "let: expected an open parenthesis before let, but found none")
(htdp-syntax-test #'(let) "let: expected at least one binding (in parentheses) after let, but nothing's there")
(htdp-syntax-test #'(let ()) "let: expected an expression after the bindings, but nothing's there")
(htdp-syntax-test #'(let 1 2) "let: expected at least one binding (in parentheses) after let, but found a number")
@ -72,7 +72,7 @@
(htdp-test 19 (let ([f (lambda (x) (+ x 10))]) f) 9)
(htdp-test 16 'let (let ([f (lambda (x) (+ x 10))]) (f 6)))
(htdp-syntax-test #'let* "let*: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'let* "let*: expected an open parenthesis before let*, but found none")
(htdp-syntax-test #'(let*) "let*: expected at least one binding (in parentheses) after let*, but nothing's there")
(htdp-syntax-test #'(let* ()) "let*: expected an expression after the bindings, but nothing's there")
(htdp-syntax-test #'(let* 1 2) "let*: expected at least one binding (in parentheses) after let*, but found a number")
@ -94,7 +94,7 @@
(htdp-test 16 'let* (let* ([f (lambda (x) (+ x 10))]) (f 6)))
(htdp-test 7779 'time (time 7779))
(htdp-syntax-test #'time "time: found a use that does not follow an open parenthesis")
(htdp-syntax-test #'time "time: expected an open parenthesis before time, but found none")
(htdp-syntax-test #'(time) "time: expected an expression after time, but nothing's there")
(htdp-syntax-test #'(time 1 2) "time: expected only one expression after time, but found 1 extra part")
(htdp-syntax-test #'(time (define x 5)) "define: found a definition that is not at the top level")