The htdp test suite now checks that the correct error messages are thrown.
This commit is contained in:
Guillaume Marceau
parent
2f3da4c4cd
commit
79589b9b9f
|
|
@ -708,7 +708,22 @@ TODO
|
|||
(reset-highlighting)
|
||||
|
||||
(set! error-ranges locs)
|
||||
|
||||
|
||||
#|
|
||||
TODO
|
||||
send: target is not an object: #f for method: begin-edit-sequence
|
||||
|
||||
=== context ===
|
||||
C:\documents\projects\plt\collects\racket\private\class-internal.rkt:4550:0: obj-error
|
||||
C:\documents\projects\plt\collects\racket\private\class-internal.rkt:3814:0: find-method/who
|
||||
C:\documents\projects\plt\collects\drracket\private\rep.rkt:719:20
|
||||
C:\documents\projects\plt\collects\racket\private\map.rkt:45:11: for-each
|
||||
C:\documents\projects\plt\collects\drracket\private\rep.rkt:660:6: core
|
||||
C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:430:6
|
||||
C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:470:32
|
||||
C:\documents\projects\plt\collects\mred\private\wx\common\queue.rkt:607:3
|
||||
|
||||
|#
|
||||
(for-each (λ (loc) (send (srcloc-source loc) begin-edit-sequence)) locs)
|
||||
|
||||
(when color?
|
||||
|
|
|
|||
|
|
@ -33,16 +33,28 @@
|
|||
(compose raise rewrite-lookup-error-message)])
|
||||
(top . id))))]))
|
||||
|
||||
(define (change-contract-exn-messages e msg)
|
||||
(define constructor
|
||||
(cond [(exn:fail:contract:arity? e) make-exn:fail:contract:arity]
|
||||
[(exn:fail:contract:divide-by-zero? e) make-exn:fail:contract:divide-by-zero]
|
||||
[(exn:fail:contract:non-fixnum-result? e) make-exn:fail:contract:non-fixnum-result]
|
||||
[(exn:fail:contract:continuation? e) make-exn:fail:contract:continuation]
|
||||
[else make-exn:fail:contract]))
|
||||
(constructor msg (exn-continuation-marks e)))
|
||||
|
||||
(define (rewrite-contract-error-message e)
|
||||
(define replacements
|
||||
(list (list #rx"expects 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)))))
|
||||
(lambda (all one two) (format "expects a ~a" two)))
|
||||
(list #rx"^procedure "
|
||||
(lambda (all) ""))
|
||||
))
|
||||
(define new-message
|
||||
(for/fold ([msg (exn-message e)]) ([repl. replacements])
|
||||
(regexp-replace* (first repl.) msg (second repl.))))
|
||||
(struct-copy exn e [message new-message]))
|
||||
(change-contract-exn-messages e new-message))
|
||||
|
||||
(define-for-syntax (wrap-for-contract-error-message* stx)
|
||||
(syntax-case stx ()
|
||||
|
|
|
|||
|
|
@ -227,9 +227,10 @@
|
|||
|
||||
;; Raise a syntax error:
|
||||
(define (teach-syntax-error form stx detail msg . args)
|
||||
(let ([form (if (eq? form '|function call|)
|
||||
(let (#;[form (if (eq? form '|function call|)
|
||||
form
|
||||
#f)] ; extract name from stx
|
||||
[form (or form (first (flatten (syntax->datum stx))))]
|
||||
[msg (apply format msg args)])
|
||||
(if detail
|
||||
(raise-syntax-error form msg stx detail)
|
||||
|
|
@ -564,7 +565,7 @@
|
|||
'define
|
||||
stx
|
||||
dup
|
||||
"found a variable that was used more than once: ~a"
|
||||
"found a variable that is used more than once: ~a"
|
||||
(syntax-e dup))))
|
||||
(check-single-result-expr (syntax->list (syntax (expr ...)))
|
||||
#f
|
||||
|
|
@ -703,7 +704,7 @@
|
|||
'lambda
|
||||
rhs
|
||||
dup
|
||||
"found a variable that was used more than once: ~a"
|
||||
"found a variable that is used more than once: ~a"
|
||||
(syntax-e dup))))
|
||||
(check-single-result-expr (syntax->list (syntax (lexpr ...)))
|
||||
#f
|
||||
|
|
@ -772,7 +773,7 @@
|
|||
'define-struct
|
||||
stx
|
||||
field
|
||||
"found a field name that was used more than once: ~a"
|
||||
"found a field name that is used more than once: ~a"
|
||||
sym))
|
||||
(hash-table-put! ht sym #t)))
|
||||
fields)
|
||||
|
|
@ -1040,7 +1041,7 @@
|
|||
'define-datatype
|
||||
stx
|
||||
v-stx
|
||||
"found a variant name that was used more than once: ~a"
|
||||
"found a variant name that is used more than once: ~a"
|
||||
v)))
|
||||
|
||||
(for-each
|
||||
|
|
@ -1063,7 +1064,7 @@
|
|||
'define-datatype
|
||||
stx
|
||||
f-stx
|
||||
"in variant `~a': found a field name that was used more than once: ~a"
|
||||
"in variant `~a': found a field name that is used more than once: ~a"
|
||||
(syntax-e #'variant)
|
||||
(syntax-e f-stx))))))
|
||||
(syntax->list #'((variant field ...) ...))))
|
||||
|
|
@ -1232,12 +1233,12 @@
|
|||
(if (not (identifier-binding #'id))
|
||||
(if (syntax-property #'id 'was-in-app-position)
|
||||
(teach-syntax-error
|
||||
'unknown
|
||||
#f
|
||||
#'id
|
||||
#f
|
||||
"this function is not defined")
|
||||
(teach-syntax-error
|
||||
'unknown
|
||||
#f
|
||||
#'id
|
||||
#f
|
||||
"this variable is not defined"))
|
||||
|
|
@ -1377,9 +1378,11 @@
|
|||
'if
|
||||
stx
|
||||
#f
|
||||
"expected a question and two answers, but found ~a part~a"
|
||||
(if (zero? n) "no" n)
|
||||
(if (= n 1) "" "s")))]
|
||||
"expected a question and two answers, but ~a"
|
||||
(cond [(zero? n) "nothing's there"]
|
||||
[(= n 1) "found only 1 part"]
|
||||
[(= n 2) "found only 2 parts"]
|
||||
[else (format "found ~a parts" n)])))]
|
||||
[_else (bad-use-error 'if stx)]))))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1405,9 +1408,9 @@
|
|||
where
|
||||
stx
|
||||
#f
|
||||
"expected at least two expressions after ~a, but found ~a"
|
||||
"expected at least two expressions after ~a, but ~a"
|
||||
where
|
||||
(if (zero? n) "no expressions" "only one expression")))
|
||||
(if (zero? n) "nothing's there" "found only one expression")))
|
||||
(let loop ([clauses-consumed 0]
|
||||
[remaining (syntax->list #`clauses)])
|
||||
(if (null? remaining)
|
||||
|
|
@ -1444,7 +1447,7 @@
|
|||
'quote
|
||||
stx
|
||||
#f
|
||||
"expected the name of the symbol after the quote, found ~a"
|
||||
"expected the name of the symbol after the quote, but found ~a"
|
||||
(something-else sym)))
|
||||
(syntax/loc stx (quote expr)))]
|
||||
[_else (bad-use-error 'quote stx)]))
|
||||
|
|
@ -1686,7 +1689,7 @@
|
|||
(syntax-e dup)))
|
||||
(let ([exprs (syntax->list (syntax exprs))])
|
||||
(check-single-expression 'local
|
||||
"after the local definition sequence"
|
||||
"after the local definitions"
|
||||
stx
|
||||
exprs
|
||||
(append val-ids stx-ids)))
|
||||
|
|
@ -1881,30 +1884,23 @@
|
|||
(let ([bindings (syntax->list (syntax (binding ...)))])
|
||||
(for-each (lambda (binding)
|
||||
(syntax-case binding ()
|
||||
[(something . exprs)
|
||||
(not (identifier/non-kw? (syntax something)))
|
||||
(teach-syntax-error
|
||||
who
|
||||
orig-stx
|
||||
(syntax something)
|
||||
"expected a variable for the binding, but found ~a"
|
||||
(something-else/kw (syntax something)))]
|
||||
[(name expr)
|
||||
(let ([name (syntax name)])
|
||||
(unless (identifier/non-kw? name)
|
||||
(teach-syntax-error
|
||||
who
|
||||
orig-stx
|
||||
name
|
||||
"expected a variable for the binding, but found ~a"
|
||||
(something-else/kw name))))]
|
||||
(void)]
|
||||
[(name . exprs)
|
||||
(identifier/non-kw? (syntax name))
|
||||
(check-single-expression who
|
||||
(format "after the name ~a"
|
||||
(syntax-e (syntax name)))
|
||||
binding
|
||||
(syntax->list (syntax exprs))
|
||||
#f)]
|
||||
[(something . exprs)
|
||||
(teach-syntax-error
|
||||
who
|
||||
orig-stx
|
||||
(syntax something)
|
||||
"expected a variable after the square bracket, but found ~a"
|
||||
(something-else/kw (syntax something)))]
|
||||
[_else
|
||||
(teach-syntax-error
|
||||
who
|
||||
|
|
@ -1927,7 +1923,7 @@
|
|||
(syntax-e dup)))))
|
||||
(let ([exprs (syntax->list (syntax exprs))])
|
||||
(check-single-expression who
|
||||
"after the name-defining sequence"
|
||||
"after the bindings"
|
||||
orig-stx
|
||||
exprs
|
||||
#f)))]
|
||||
|
|
@ -2050,7 +2046,7 @@
|
|||
"found a variable that is used more than once: ~a"
|
||||
(syntax-e dup))))
|
||||
(check-single-expression 'lambda
|
||||
"within lambda"
|
||||
"after the variables"
|
||||
stx
|
||||
(syntax->list (syntax (lexpr ...)))
|
||||
args)
|
||||
|
|
@ -2082,7 +2078,7 @@
|
|||
[(_ expr ...)
|
||||
(begin
|
||||
(check-single-expression 'quote
|
||||
"after the quote keyword"
|
||||
"after quote"
|
||||
stx
|
||||
(syntax->list (syntax (expr ...)))
|
||||
;; Don't expand expr!
|
||||
|
|
@ -2406,24 +2402,28 @@
|
|||
stx
|
||||
(lambda ()
|
||||
(syntax-case stx ()
|
||||
[(_ q expr ...)
|
||||
(let ([exprs (syntax->list (syntax (expr ...)))])
|
||||
(check-single-expression who
|
||||
(format "for the answer in ~a"
|
||||
who)
|
||||
stx
|
||||
exprs
|
||||
null)
|
||||
(with-syntax ([who who]
|
||||
[target target-stx])
|
||||
(syntax/loc stx (target (verify-boolean q 'who) expr ...))))]
|
||||
[(_)
|
||||
(teach-syntax-error
|
||||
who
|
||||
stx
|
||||
#f
|
||||
"expected a question after ~a, but nothing's there"
|
||||
who)]
|
||||
"expected a question and an answer, but nothing's there")]
|
||||
[(_ q)
|
||||
(teach-syntax-error
|
||||
who
|
||||
stx
|
||||
#'q
|
||||
"expected a question and an answer, but found only one part")]
|
||||
[(_ q a)
|
||||
(with-syntax ([who who]
|
||||
[target target-stx])
|
||||
(syntax/loc stx (target (verify-boolean q 'who) a)))]
|
||||
[(_ . parts)
|
||||
(teach-syntax-error*
|
||||
who
|
||||
stx
|
||||
(syntax->list #'parts)
|
||||
"expected a question and an answer, but found ~a parts" (length (syntax->list #'parts)))]
|
||||
[_else
|
||||
(bad-use-error who stx)])))))])
|
||||
(values (mk 'when (quote-syntax when))
|
||||
|
|
@ -2445,17 +2445,22 @@
|
|||
stx
|
||||
(lambda ()
|
||||
(syntax-case stx ()
|
||||
[(_ name ids body)
|
||||
[(_form name . rest)
|
||||
(identifier/non-kw? (syntax name))
|
||||
(syntax/loc stx (let name ids body))]
|
||||
[(_ name . rest)
|
||||
(begin
|
||||
(bad-let-form 'let (syntax (_form . rest)) stx)
|
||||
(syntax/loc stx (let name . rest)))]
|
||||
[(_ name)
|
||||
(identifier/non-kw? (syntax name))
|
||||
(teach-syntax-error
|
||||
'let
|
||||
(teach-syntax-error
|
||||
'let
|
||||
stx
|
||||
#f
|
||||
"bad syntax for named let")]
|
||||
[(_ . rest)
|
||||
"expected at least one binding (in parentheses) after ~a, but nothing's there" (syntax->datum (syntax name)))]
|
||||
[(_form name . rest)
|
||||
(identifier/non-kw? (syntax name))
|
||||
(bad-let-form 'let (syntax (_form . rest)) stx)]
|
||||
[(_ . rest)
|
||||
(syntax/loc stx (intermediate-let . rest))]
|
||||
[_else
|
||||
(bad-use-error 'let stx)]))))
|
||||
|
|
@ -2517,7 +2522,7 @@
|
|||
'case
|
||||
stx
|
||||
#f
|
||||
"expected a clause with choices and an answer after the expression, but nothing's there")]
|
||||
"expected a clause with at least one choice (in parentheses) and an answer after the expression, but nothing's there")]
|
||||
[(_ v-expr clause ...)
|
||||
(let ([clauses (syntax->list (syntax (clause ...)))])
|
||||
(for-each
|
||||
|
|
@ -2534,7 +2539,7 @@
|
|||
in its case expression"))
|
||||
(let ([answers (syntax->list (syntax (answer ...)))])
|
||||
(check-single-expression 'case
|
||||
"for the answer in a case clause"
|
||||
"for the answer in the case clause"
|
||||
clause
|
||||
answers
|
||||
null)))]
|
||||
|
|
@ -2568,7 +2573,7 @@
|
|||
choices
|
||||
"expected at least one choice (in parentheses), but nothing's there"))
|
||||
(check-single-expression 'case
|
||||
"for the answer in a case clause"
|
||||
"for the answer in the case clause"
|
||||
clause
|
||||
answers
|
||||
null))]
|
||||
|
|
@ -2743,7 +2748,7 @@
|
|||
[(_ expr ...)
|
||||
(begin
|
||||
(check-single-expression 'delay
|
||||
"after the delay keyword"
|
||||
"after delay"
|
||||
stx
|
||||
(syntax->list (syntax (expr ...)))
|
||||
null)
|
||||
|
|
@ -2813,7 +2818,18 @@
|
|||
"after the bindings"
|
||||
stx
|
||||
(syntax->list (syntax exprs))
|
||||
#f))]
|
||||
#f)
|
||||
(let ([dup (check-duplicate-identifier (map (lambda (binding)
|
||||
(syntax-case binding ()
|
||||
[(name . _) (syntax name)]))
|
||||
bindings))])
|
||||
(when dup
|
||||
(teach-syntax-error
|
||||
'shared
|
||||
stx
|
||||
dup
|
||||
"found a variable that is used more than once: ~a"
|
||||
(syntax-e dup)))))]
|
||||
[(_ bad-bind . exprs)
|
||||
(teach-syntax-error
|
||||
'shared
|
||||
|
|
|
|||
|
|
@ -462,10 +462,10 @@ namespace.
|
|||
;; is s a list of 1-letter strings
|
||||
;; effect: not a list, not a list of strings
|
||||
(define (1-letter*? tag s)
|
||||
(unless (list? s) (err tag "expected a ~a, but received a list: ~e" 1-LETTER* s))
|
||||
(unless (list? s) (err tag "expected a ~a, but received: ~e" 1-LETTER* s))
|
||||
(for-each
|
||||
(lambda (c)
|
||||
(unless (string? c) (err tag "expected a ~a, but received a string: ~e" 1-LETTER* c)))
|
||||
(unless (string? c) (err tag "expected a ~a, but received: ~e" 1-LETTER* c)))
|
||||
s)
|
||||
(andmap (compose (curry = 1) string-length) s))
|
||||
|
||||
|
|
|
|||
|
|
@ -38,12 +38,12 @@
|
|||
(define x8 (lambda () 11))
|
||||
(test 11 x8)
|
||||
|
||||
(htdp-syntax-test #'begin)
|
||||
(htdp-syntax-test #'(begin))
|
||||
(htdp-syntax-test #'(begin (define x 10)))
|
||||
(htdp-syntax-test #'(begin (define x 10) x))
|
||||
(htdp-syntax-test #'(let () (begin (define x 10) x)))
|
||||
(htdp-syntax-test #'(+ 1 (begin)))
|
||||
(htdp-syntax-test #'begin "begin: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(let () (begin (define x 10) x)) "define: found a definition that is not at the top level")
|
||||
(htdp-syntax-test #'(+ 1 (begin)) "begin: expected at least one expression after begin, but nothing's there")
|
||||
|
||||
(test 1 'begin (begin 1))
|
||||
(test 2 'begin (begin 1 2))
|
||||
|
|
@ -54,21 +54,21 @@
|
|||
(htdp-test 12 'begin+set! (begin 12 ex))
|
||||
(htdp-top-pop 1)
|
||||
|
||||
(htdp-syntax-test #'begin0)
|
||||
(htdp-syntax-test #'(begin0))
|
||||
(htdp-syntax-test #'begin0 "begin0: found a use that does not follow an open parenthesis")
|
||||
(htdp-syntax-test #'(begin0) "begin: expected at least one expression after begin0, but nothing's there")
|
||||
|
||||
(htdp-test 1 'begin0 (begin0 1))
|
||||
(htdp-test 2 'begin0 (begin0 2 1))
|
||||
(htdp-test 3 'begin0 (begin0 3 2 1))
|
||||
|
||||
(htdp-syntax-test #'set!)
|
||||
(htdp-syntax-test #'(set!))
|
||||
(htdp-syntax-test #'(set! x))
|
||||
(htdp-syntax-test #'(set! 1 2))
|
||||
(htdp-syntax-test #'(set! x 2 3))
|
||||
(htdp-syntax-test #'(set! set! 2))
|
||||
(htdp-syntax-test #'(lambda (x) (set! x 2)))
|
||||
(htdp-syntax-test #'(let ([x 5]) (lambda (x) (set! x 2))))
|
||||
(htdp-syntax-test #'set! "set!: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(set! x 2 3) "set!: expected only one expression for the new value, but found 1 extra part")
|
||||
(htdp-syntax-test #'(set! set! 2) "set!: expected a variable after set!, but found a set!")
|
||||
(htdp-syntax-test #'(lambda (x) (set! x 2)) "set!: expected a mutable variable after set!, but found a variable that cannot be modified")
|
||||
(htdp-syntax-test #'(let ([x 5]) (lambda (x) (set! x 2))) "set!: expected a mutable variable after set!, but found a variable that cannot be modified")
|
||||
|
||||
(htdp-top (set! x 'hello))
|
||||
(htdp-test 'hello 'access-x x)
|
||||
|
|
@ -83,9 +83,9 @@
|
|||
x)))
|
||||
45)
|
||||
|
||||
(htdp-syntax-test #'delay)
|
||||
(htdp-syntax-test #'(delay))
|
||||
(htdp-syntax-test #'(delay 1 2))
|
||||
(htdp-syntax-test #'delay "delay: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
|
||||
(htdp-top (define d (delay (begin (set! x 89) 12))))
|
||||
(htdp-test #t promise? d)
|
||||
|
|
@ -96,33 +96,43 @@
|
|||
(htdp-test 12 force d)
|
||||
(htdp-test 13 'access-x x)
|
||||
|
||||
(htdp-syntax-test #'(let name))
|
||||
(htdp-syntax-test #'(let name 10))
|
||||
(htdp-syntax-test #'(let name ()))
|
||||
(htdp-syntax-test #'(let name ([x]) 1))
|
||||
(htdp-syntax-test #'(let name ([x 10] 2) 1))
|
||||
(htdp-syntax-test #'(let name ([11 10]) 1))
|
||||
(htdp-syntax-test #'(let name ([x 10]) 1 2))
|
||||
(htdp-syntax-test #'(let name ([x 10][x 11]) 1))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
"let: bad syntax (not a sequence of identifier--expression bindings)"
|
||||
|
||||
|
||||
(htdp-syntax-test #'(let name) "let: expected at least one binding (in parentheses) after let, but nothing's there")
|
||||
(htdp-syntax-test #'(let name 10) "let: expected at least one binding (in parentheses) after let, but found a number")
|
||||
(htdp-syntax-test #'(let name ()) "let: expected an expression after the bindings, but nothing's there")
|
||||
(htdp-syntax-test #'(let name ([x]) 1) "let: expected an expression after the name x, but nothing's there")
|
||||
(htdp-syntax-test #'(let name ([x 10] 2) 1) "let: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(let name ([11 10]) 1) "let: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(let name ([x 10]) 1 2) "let: expected only one expression after the bindings, but found 1 extra part")
|
||||
(htdp-syntax-test #'(let name ([x 10][x 11]) 1) "let: x was defined locally more than once")
|
||||
(htdp-test 10 'lookup (let name () 10))
|
||||
(htdp-test 1024 'loop (let loop ([n 10]) (if (zero? n) 1 (* 2 (loop (sub1 n))))))
|
||||
|
||||
(htdp-test 19 'lookup (recur empty-f () 19))
|
||||
|
||||
(htdp-syntax-test #'case)
|
||||
(htdp-syntax-test #'(case))
|
||||
(htdp-syntax-test #'(case 5))
|
||||
(htdp-syntax-test #'(case 5 12))
|
||||
(htdp-syntax-test #'(case 5 []))
|
||||
(htdp-syntax-test #'(case 5 [5 10]))
|
||||
(htdp-syntax-test #'(case 5 [(5) 10] 12))
|
||||
(htdp-syntax-test #'(case 5 [(5)]))
|
||||
(htdp-syntax-test #'(case 5 [(5) 12 13]))
|
||||
(htdp-syntax-test #'(case 5 [("a") 10]))
|
||||
(htdp-syntax-test #'(case 5 [() 10]))
|
||||
(htdp-syntax-test #'(case 5 [(5 "a") 10]))
|
||||
(htdp-syntax-test #'(case 5 [else 12][(5) 10]))
|
||||
(htdp-syntax-test #'(case 5 [(5) 10][else 12][else 13]))
|
||||
(htdp-syntax-test #'case "case: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(case 5 []) "case: expected a clause with at least one choice (in parentheses) and an answer, but found an empty part")
|
||||
(htdp-syntax-test #'(case 5 [5 10]) "case: expected at least one choice (in parentheses), but found a number")
|
||||
(htdp-syntax-test #'(case 5 [(5) 10] 12) "case: expected a clause with at least one choice (in parentheses) and an answer, but found a number")
|
||||
(htdp-syntax-test #'(case 5 [(5)]) "case: expected an expression for the answer in the case clause, but nothing's there")
|
||||
(htdp-syntax-test #'(case 5 [(5) 12 13]) "case: expected only one expression for the answer in the case clause, but found 1 extra part")
|
||||
(htdp-syntax-test #'(case 5 [("a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string")
|
||||
(htdp-syntax-test #'(case 5 [() 10]) "case: expected at least one choice, but nothing's there")
|
||||
(htdp-syntax-test #'(case 5 [(5 "a") 10]) "case: expected a symbol (without its quote) or a number as a choice, but found a string")
|
||||
(htdp-syntax-test #'(case 5 [else 12][(5) 10]) "case: found an else clause that isn't the last clause in its case expression")
|
||||
(htdp-syntax-test #'(case 5 [(5) 10][else 12][else 13]) "case: found an else clause that isn't the last clause in its case expression")
|
||||
|
||||
(htdp-test 'a 'case (case 5 [(5) 'a]))
|
||||
(htdp-test 'b 'case (case 5 [(6) 'a][else 'b]))
|
||||
|
|
@ -131,37 +141,37 @@
|
|||
(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)
|
||||
(htdp-syntax-test #'(when))
|
||||
(htdp-syntax-test #'(when 10))
|
||||
(htdp-syntax-test #'(when 10 12 13))
|
||||
(htdp-syntax-test #'when "when: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
|
||||
(htdp-err/rt-test (when 1 2))
|
||||
(htdp-err/rt-test (when 1 2) rx:not-true-or-false)
|
||||
|
||||
(htdp-test (void) 'when (when false 1))
|
||||
(htdp-test 11 'when (when true 11))
|
||||
|
||||
(htdp-syntax-test #'unless)
|
||||
(htdp-syntax-test #'(unless))
|
||||
(htdp-syntax-test #'(unless 10))
|
||||
(htdp-syntax-test #'(unless 10 12 13))
|
||||
(htdp-syntax-test #'unless "unless: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
|
||||
(htdp-err/rt-test (unless 1 2))
|
||||
(htdp-err/rt-test (unless 1 2) rx:not-true-or-false)
|
||||
|
||||
(htdp-test (void) 'unless (unless true 1))
|
||||
(htdp-test 11 'unless (unless false 11))
|
||||
|
||||
(htdp-syntax-test #'shared)
|
||||
(htdp-syntax-test #'(shared))
|
||||
(htdp-syntax-test #'(shared ()))
|
||||
(htdp-syntax-test #'(shared 1 2))
|
||||
(htdp-syntax-test #'(shared () 1 2))
|
||||
(htdp-syntax-test #'(shared (x) 2))
|
||||
(htdp-syntax-test #'(shared ([]) 2))
|
||||
(htdp-syntax-test #'(shared ([x]) 2))
|
||||
(htdp-syntax-test #'(shared ([x 1 3]) 2))
|
||||
(htdp-syntax-test #'(shared ([1 3]) 2))
|
||||
(htdp-syntax-test #'(shared ([x 1][x 2]) 2))
|
||||
(htdp-syntax-test #'shared "shared: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(shared () 1 2) "shared: expected only one expression after the bindings, but found 1 extra part")
|
||||
(htdp-syntax-test #'(shared (x) 2) "shared: expected a binding with a variable and an expression, but found something else")
|
||||
(htdp-syntax-test #'(shared ([]) 2) "shared: expected a variable for a binding, but nothing's there")
|
||||
(htdp-syntax-test #'(shared ([x]) 2) "shared: expected an expression after the binding name, but nothing's there")
|
||||
(htdp-syntax-test #'(shared ([x 1 3]) 2) "shared: expected only one expression after the binding name, but found 1 extra part")
|
||||
(htdp-syntax-test #'(shared ([1 3]) 2) "shared: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(shared ([x 1][x 2]) 2) "shared: found a variable that is used more than once: x")
|
||||
|
||||
(htdp-test 1 'shared (shared () 1))
|
||||
(htdp-test 1 'shared (shared ([x 1]) x))
|
||||
|
|
@ -174,17 +184,17 @@
|
|||
(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)
|
||||
(htdp-syntax-test #'(recur))
|
||||
(htdp-syntax-test #'(recur 10))
|
||||
(htdp-syntax-test #'(recur name))
|
||||
(htdp-syntax-test #'(recur name 10))
|
||||
(htdp-syntax-test #'(recur name ([x 1])))
|
||||
(htdp-syntax-test #'(recur name ([x]) 1))
|
||||
(htdp-syntax-test #'(recur name ([x 10] 2) 1))
|
||||
(htdp-syntax-test #'(recur name ([11 10]) 1))
|
||||
(htdp-syntax-test #'(recur name ([x 10]) 1 2))
|
||||
(htdp-syntax-test #'(recur name ([x 10][x 11]) 1))
|
||||
(htdp-syntax-test #'recur "recur: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(recur name 10) "recur: expected at least one binding (in parentheses) after recur, but found a number")
|
||||
(htdp-syntax-test #'(recur name ([x 1])) "recur: expected an expression after the bindings, but nothing's there")
|
||||
(htdp-syntax-test #'(recur name ([x]) 1) "recur: expected an expression after the name x, but nothing's there")
|
||||
(htdp-syntax-test #'(recur name ([x 10] 2) 1) "recur: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(recur name ([11 10]) 1) "recur: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(recur name ([x 10]) 1 2) "recur: expected only one expression after the bindings, but found 1 extra part")
|
||||
(htdp-syntax-test #'(recur name ([x 10][x 11]) 1) "recur: x was defined locally more than once")
|
||||
(htdp-test 18 'lookup (recur name ([x 18]) x))
|
||||
(htdp-test 1024 'loop (recur loop ([n 10]) (if (zero? n) 1 (* 2 (loop (sub1 n))))))
|
||||
(htdp-test 13 'loop (recur f ([f 13]) f))
|
||||
|
|
@ -192,6 +202,9 @@
|
|||
|
||||
(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-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)))
|
||||
(htdp-test #t 'equal? (equal? (shared ([x (cons (vector x) x)]) x) (shared ([x (cons (vector x) x)]) x)))
|
||||
|
|
@ -409,21 +422,22 @@
|
|||
|
||||
;; define-datatype
|
||||
|
||||
(htdp-syntax-test #'define-datatype #rx"define-datatype: found a use of `define-datatype' that does not follow an open parenthesis")
|
||||
(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 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")
|
||||
(htdp-syntax-test #'(define-datatype dt v1) #rx"define-datatype: expected a variant after the datatype type name in `define-datatype', but found something else")
|
||||
(htdp-syntax-test #'(define-datatype dt [v1 f1 f1]) #rx"define-datatype: in variant `v1': found a field name that was used more than once: f1")
|
||||
(htdp-syntax-test #'(define-datatype dt [v1 f1 f1]) #rx"define-datatype: in variant `v1': found a field name that is used more than once: f1")
|
||||
(htdp-syntax-test #'(define-datatype dt [10]) #rx"define-datatype: expected a variant name, found a number")
|
||||
(htdp-syntax-test #'(define-datatype dt [(v1)]) #rx"define-datatype: expected a variant name, found something else")
|
||||
(htdp-syntax-test #'(define-datatype dt [(v1)]) #rx"define-datatype: expected a variant name, found a part")
|
||||
(htdp-syntax-test #'(define-datatype dt [v1 10]) #rx"define-datatype: in variant `v1': expected a field name, found a number")
|
||||
(htdp-syntax-test #'(define-datatype dt [v1] [v1]) #rx"define-datatype: found a variant name that was used more than once: v1")
|
||||
(htdp-syntax-test #'(define-datatype dt [v1] [v1]) #rx"define-datatype: found a variant name that is used more than once: v1")
|
||||
(htdp-syntax-test #'(define-datatype posn [v1]) #rx"posn\\?: this name has a built-in meaning and cannot be re-defined")
|
||||
(htdp-syntax-test #'(define-datatype dt [posn]) #rx"posn: this name has a built-in meaning and cannot be re-defined")
|
||||
(htdp-syntax-test #'(define-datatype lambda [v1]) #rx"define-datatype: expected a datatype type name after `define-datatype', but found a keyword")
|
||||
(htdp-syntax-test #'(define-datatype dt [lambda]) #rx"define-datatype: expected a variant name, found a keyword")
|
||||
(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype', but found something else")
|
||||
(htdp-syntax-test #'(define-datatype (dt)) #rx"define-datatype: expected a datatype type name after `define-datatype',
|
||||
but found a part")
|
||||
(htdp-syntax-test #'(+ 1 (define-datatype dt [v1])) #rx"define-datatype: found a definition that is not at the top level")
|
||||
|
||||
(htdp-top (define-datatype dt))
|
||||
|
|
@ -452,7 +466,7 @@
|
|||
|
||||
;; match
|
||||
|
||||
(htdp-syntax-test #'match #rx"match: found a use of `match' that does not follow an open parenthesis")
|
||||
(htdp-syntax-test #'match #rx"match: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
|
||||
|
|
|
|||
|
|
@ -1,64 +1,63 @@
|
|||
|
||||
(htdp-syntax-test #'())
|
||||
(htdp-syntax-test #'() "function call: expected a function after the open parenthesis, but nothing's there")
|
||||
|
||||
(htdp-syntax-test #'#%app)
|
||||
|
||||
(htdp-syntax-test #'quote)
|
||||
(htdp-syntax-test #'(quote 1 2))
|
||||
|
||||
(htdp-syntax-test #'define)
|
||||
(htdp-syntax-test #'(define))
|
||||
(htdp-syntax-test #'(define x))
|
||||
(htdp-syntax-test #'(define x 10 12))
|
||||
(htdp-syntax-test #'(define (10 y) 12))
|
||||
(htdp-syntax-test #'(define (10) 12))
|
||||
(htdp-syntax-test #'(define ("x" y) 12))
|
||||
(htdp-syntax-test #'(define (y 10) 12))
|
||||
(htdp-syntax-test #'(define (y "x") 12))
|
||||
(htdp-syntax-test #'(define (y z 10) 12))
|
||||
(htdp-syntax-test #'(define (x y) 10 12))
|
||||
(htdp-syntax-test #'(define (x y y) 10))
|
||||
(htdp-syntax-test #'(define () 10))
|
||||
(htdp-syntax-test #'(define 1 10))
|
||||
(htdp-syntax-test #'(define x lambda))
|
||||
(htdp-syntax-test #'(define x (lambda)))
|
||||
(htdp-syntax-test #'(define x (lambda (x))))
|
||||
(htdp-syntax-test #'(define x (lambda y)))
|
||||
(htdp-syntax-test #'(define x (lambda y 10)))
|
||||
(htdp-syntax-test #'(define x (lambda (10) 10)))
|
||||
(htdp-syntax-test #'(define x (lambda (x 10) 10)))
|
||||
(htdp-syntax-test #'(define x (lambda (y) 10 11)))
|
||||
(htdp-syntax-test #'(define x (lambda (y) 10 11)))
|
||||
(htdp-syntax-test #'(define x (lambda (y y) 10)))
|
||||
(htdp-syntax-test #'(+ (define x 5)))
|
||||
(htdp-syntax-test #'define "define: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(define (10 y) 12) "define: expected the name of the function, but found a number")
|
||||
(htdp-syntax-test #'(define (10) 12) "define: expected the name of the function, but found a number")
|
||||
(htdp-syntax-test #'(define ("x" y) 12) "define: expected the name of the function, but found a string")
|
||||
(htdp-syntax-test #'(define (y 10) 12) "define: expected a variable, but found a number")
|
||||
(htdp-syntax-test #'(define (y "x") 12) "define: expected a variable, but found a string")
|
||||
(htdp-syntax-test #'(define (y z 10) 12) "define: expected a variable, but found a number")
|
||||
(htdp-syntax-test #'(define (x y) 10 12) "define: expected only one expression for the function body, but found 1 extra part")
|
||||
(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 at least one variable (in parentheses) after lambda, but nothing's there")
|
||||
(htdp-syntax-test #'(define x (lambda (x))) "lambda: expected an expression after the variables, 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")
|
||||
(htdp-syntax-test #'(define x (lambda y 10) "lambda: expected at least one variable (in parentheses) after lambda, but found something else"))
|
||||
(htdp-syntax-test #'(define x (lambda (10) 10)) "lambda: expected a variable, but found a number")
|
||||
(htdp-syntax-test #'(define x (lambda (x 10) 10)) "lambda: expected a variable, but found a number")
|
||||
(htdp-syntax-test #'(define x (lambda (y) 10 11)) "lambda: expected only one expression after the variables, but found 1 extra part")
|
||||
(htdp-syntax-test #'(define x (lambda (y y) 10)) "lambda: found a variable that is used more than once: y")
|
||||
(htdp-syntax-test #'(+ (define x 5)) "define: found a definition that is not at the top level")
|
||||
|
||||
;; Keywords:
|
||||
(htdp-syntax-test #'(define (define y) 12))
|
||||
(htdp-syntax-test #'(define (lambda y) 12))
|
||||
(htdp-syntax-test #'(define (cond y) 12))
|
||||
(htdp-syntax-test #'(define (if y) 12))
|
||||
(htdp-syntax-test #'(define (y define) 12))
|
||||
(htdp-syntax-test #'(define (y lambda) 12))
|
||||
(htdp-syntax-test #'(define (y cond) 12))
|
||||
(htdp-syntax-test #'(define (y if) 12))
|
||||
(htdp-syntax-test #'(define (y and) 12))
|
||||
(htdp-syntax-test #'(define (y or) 12))
|
||||
(htdp-syntax-test #'(define (y true) 12))
|
||||
(htdp-syntax-test #'(define (y false) 12))
|
||||
(htdp-syntax-test #'(define (y empty) 12))
|
||||
(htdp-syntax-test #'(define (define y) 12) "define: expected the name of the function, but found a keyword")
|
||||
(htdp-syntax-test #'(define (lambda y) 12) "define: expected the name of the function, but found a keyword")
|
||||
(htdp-syntax-test #'(define (cond y) 12) "define: expected the name of the function, but found a keyword")
|
||||
(htdp-syntax-test #'(define (if y) 12) "define: expected the name of the function, but found a keyword")
|
||||
(htdp-syntax-test #'(define (y define) 12) "define: expected a variable, but found a keyword")
|
||||
(htdp-syntax-test #'(define (y lambda) 12) "define: expected a variable, but found a keyword")
|
||||
(htdp-syntax-test #'(define (y cond) 12) "define: expected a variable, but found a keyword")
|
||||
(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)
|
||||
(htdp-syntax-test #'(define-struct))
|
||||
(htdp-syntax-test #'(define-struct a))
|
||||
(htdp-syntax-test #'(define-struct a (b) 10))
|
||||
(htdp-syntax-test #'(define-struct a (b) 10 11 12))
|
||||
(htdp-syntax-test #'(define-struct 10 (b)))
|
||||
(htdp-syntax-test #'(define-struct a b))
|
||||
(htdp-syntax-test #'(define-struct a (10)))
|
||||
(htdp-syntax-test #'(define-struct a (b 10)))
|
||||
(htdp-syntax-test #'(define-struct (a) (b)))
|
||||
(htdp-syntax-test #'(define-struct a (b b)))
|
||||
(htdp-syntax-test #'(define-struct lambda (b)))
|
||||
(htdp-syntax-test #'(+ 1 (define-struct a (b))))
|
||||
(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 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 (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")
|
||||
(htdp-syntax-test #'(define-struct a (b b)) "define-struct: found a field name that is used more than once: b")
|
||||
(htdp-syntax-test #'(define-struct lambda (b)) "define-struct: expected the structure name after define-struct, but found a keyword")
|
||||
(htdp-syntax-test #'(+ 1 (define-struct a (b))) "define-struct: found a definition that is not at the top level")
|
||||
|
||||
(htdp-top (define x 5))
|
||||
(htdp-top (define (f y) (+ x y)))
|
||||
|
|
@ -77,49 +76,50 @@
|
|||
(htdp-test #t 'a3? (a3? (make-a3 1 2 3)))
|
||||
(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) #rx"a1-b")
|
||||
(htdp-syntax-test #'(a0 1 2 3))
|
||||
(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 #'cond)
|
||||
(htdp-syntax-test #'(cond))
|
||||
(htdp-syntax-test #'(cond 1))
|
||||
(htdp-syntax-test #'(cond [#t 6] 2))
|
||||
(htdp-syntax-test #'(cond [else 6] [#f 10]))
|
||||
(htdp-syntax-test #'(cond [else 6] [else 10]))
|
||||
(htdp-syntax-test #'(cond []))
|
||||
(htdp-syntax-test #'(cond [1]))
|
||||
(htdp-syntax-test #'(cond [1 2 3]))
|
||||
(htdp-syntax-test #'(cond [1 2][]))
|
||||
(htdp-syntax-test #'(cond [1 2][3 4 5]))
|
||||
(htdp-syntax-test #'cond "cond: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(cond [else 6] [#f 10]) "cond: found an else clause that isn't the last clause in its cond expression")
|
||||
(htdp-syntax-test #'(cond [else 6] [else 10]) "cond: found an else clause that isn't the last clause in its cond expression")
|
||||
(htdp-syntax-test #'(cond []) "cond: expected a clause with a question and an answer, but found an empty part")
|
||||
(htdp-syntax-test #'(cond [1]) "cond: expected a clause with a question and an answer, but found a clause with only one part")
|
||||
(htdp-syntax-test #'(cond [1 2 3]) "cond: expected a clause with a question and an answer, but found a clause with 3 parts")
|
||||
(htdp-syntax-test #'(cond [1 2][]) "cond: expected a clause with a question and an answer, but found an empty part")
|
||||
(htdp-syntax-test #'(cond [1 2][3 4 5]) "cond: expected a clause with a question and an answer, but found a clause with 3 parts")
|
||||
|
||||
(htdp-test 17 'cond (cond [else 17]))
|
||||
(htdp-test 18 'cond (cond [#t 18]))
|
||||
(htdp-test 19 'cond (cond [(zero? 10) 0] [#t 19]))
|
||||
(htdp-test 19 'cond (cond [(zero? 10) 0] [else 19]))
|
||||
|
||||
(htdp-err/rt-test (cond [#f 10]) exn:fail?) ;; Should it be a different exception?
|
||||
|
||||
(htdp-err/rt-test (cond [#f 10]) "cond: all question results were false") ;; Should it be a different exception?
|
||||
(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)
|
||||
(htdp-syntax-test #'(if))
|
||||
(htdp-syntax-test #'(if #t))
|
||||
(htdp-syntax-test #'(if #t 1))
|
||||
(htdp-syntax-test #'(if #t 1 2 3))
|
||||
(htdp-syntax-test #'if "if: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(if #t 1 2 3) "if: expected a question and two answers, but found 4 parts")
|
||||
|
||||
(htdp-err/rt-test (if 1 2 3) rx:not-true-or-false)
|
||||
|
||||
(htdp-syntax-test #'and)
|
||||
(htdp-syntax-test #'(and))
|
||||
(htdp-syntax-test #'(and #t))
|
||||
(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-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)
|
||||
(htdp-syntax-test #'(or))
|
||||
(htdp-syntax-test #'(or #t))
|
||||
(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-err/rt-test (or 1 #f) rx:not-true-or-false)
|
||||
(htdp-err/rt-test (or #f 1) rx:not-true-or-false)
|
||||
|
|
@ -128,8 +128,6 @@
|
|||
(htdp-test #t 'empty? (empty? empty))
|
||||
(htdp-test #t 'cons? (cons? (cons 1 empty)))
|
||||
|
||||
(htdp-err/rt-test (cons 1 2))
|
||||
(htdp-err/rt-test (append (list 1) 2))
|
||||
|
||||
(htdp-test #t 'boolean? (boolean? true))
|
||||
(htdp-test #t 'boolean? (boolean? false))
|
||||
|
|
@ -159,6 +157,9 @@
|
|||
(htdp-error-test #'(define-struct an-example (function y)))
|
||||
(htdp-top-pop 1)
|
||||
|
||||
|
||||
|
||||
|
||||
(htdp-test #t 'equal? (equal? 1 1))
|
||||
(htdp-test #t 'equal? (equal? (list 1) (list 1)))
|
||||
(htdp-test #t 'equal? (equal? (list #i1.0 2) (list #i1.0 2)))
|
||||
|
|
@ -223,15 +224,17 @@
|
|||
;; Error messages
|
||||
(htdp-top (define my-x 5))
|
||||
(htdp-top (define (my-f x) (+ x 5)))
|
||||
|
||||
(htdp-syntax-test #'(cond [true my-x 5]) #rx"found a clause with 3 parts")
|
||||
(htdp-syntax-test #'(define foo17 my-x 5) #rx"found one extra part")
|
||||
(htdp-syntax-test #'(my-y 17) #rx"not defined, not a parameter, and not a primitive name")
|
||||
(htdp-syntax-test #'(cond [true my-y 17]) #rx"not defined, not a parameter, and not a primitive name")
|
||||
(htdp-syntax-test #'(define foo17 my-x 5) #rx"define: expected only one expression after the variable name foo17, but found 1 extra part")
|
||||
(htdp-syntax-test #'(my-y 17) #rx"my-y: this function is not defined")
|
||||
(htdp-syntax-test #'(cond [true my-y 17]) #rx"my-y: this variable is not defined")
|
||||
(htdp-syntax-test #'(define my-f 12) #rx"cannot be re-defined")
|
||||
(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"does not follow")
|
||||
(htdp-syntax-test #'define #rx"define: found a use that does not follow an open parenthesis")
|
||||
|
||||
|
||||
(htdp-syntax-test #'(require) #rx"found nothing")
|
||||
(htdp-syntax-test #'(require a!) #rx"bad syntax for a module path")
|
||||
|
|
@ -298,88 +301,69 @@
|
|||
(htdp-test 2 'two 2)
|
||||
(htdp-top-pop 1)
|
||||
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; mf's tests for string functions replacing chars
|
||||
|
||||
(htdp-test "h" 'string-ith (string-ith "hell" 0))
|
||||
|
||||
(htdp-err/rt-test (string-ith "hell" 4) exn:fail:contract?
|
||||
#;
|
||||
(string-append
|
||||
"string-ith:"
|
||||
" <exact integer in [0, length of the given string (4)]>"
|
||||
" for second argument expected, given "
|
||||
"4"))
|
||||
(htdp-err/rt-test (string-ith "hell" 4)
|
||||
(exn-type-and-msg exn:fail:contract?
|
||||
"string-ith: expected an exact integer in [0, length of the given string] for the second argument, but received 4"))
|
||||
|
||||
(htdp-err/rt-test (string-ith 10 4) exn:fail:contract?
|
||||
#;
|
||||
(string-append "string-ith: <string> for first argument expected, given "
|
||||
"10"))
|
||||
(htdp-err/rt-test (string-ith 10 4)
|
||||
(exn-type-and-msg exn:fail:contract?
|
||||
"string-ith: expected a string for the first argument, but received 10"))
|
||||
|
||||
(htdp-err/rt-test (string-ith "10" 'a) exn:fail:contract?
|
||||
#;
|
||||
(string-append "string-ith: <natural number> for second argument expected, given "
|
||||
"a"))
|
||||
|
||||
(htdp-err/rt-test (string-ith "10" 'a)
|
||||
(exn-type-and-msg exn:fail:contract?
|
||||
"string-ith: expected a natural number for the second argument, but received 'a"))
|
||||
|
||||
(htdp-test "aaa" 'replicate (replicate 3 "a"))
|
||||
|
||||
(htdp-test "ababab" 'replicate (replicate 3 "ab"))
|
||||
|
||||
(htdp-err/rt-test (replicate 3 10) exn:fail:contract?
|
||||
#;
|
||||
"replicate: <string> expected, given 10")
|
||||
(htdp-err/rt-test (replicate 3 10)
|
||||
(exn-type-and-msg exn:fail:contract? "replicate: expected a string, but received 10"))
|
||||
|
||||
(htdp-test "\n" 'int->string (int->string 10))
|
||||
|
||||
(htdp-err/rt-test (int->string 56555) exn:fail:contract?
|
||||
#;
|
||||
(string-append
|
||||
"int->string: <exact integer in [0,55295] or [57344 1114111]> expected, given "
|
||||
"56555"))
|
||||
(htdp-err/rt-test (int->string 56555)
|
||||
(exn-type-and-msg exn:fail:contract? "int->string: expected an exact integer in [0,55295] or [57344 1114111], but received 56555"))
|
||||
|
||||
(htdp-err/rt-test (int->string "A") exn:fail:contract?
|
||||
#;
|
||||
(string-append
|
||||
"int->string: <exact integer in [0,55295] or [57344 1114111]> expected, given "
|
||||
(format "~s" "A")))
|
||||
(htdp-err/rt-test (int->string "A")
|
||||
(exn-type-and-msg exn:fail:contract? "int->string: expected an exact integer in [0,55295] or [57344 1114111], but received \"A\""))
|
||||
|
||||
(htdp-test 65 'string->int (string->int "A"))
|
||||
|
||||
(htdp-err/rt-test (string->int 10) exn:fail:contract?
|
||||
#;
|
||||
(string-append "string->int: " 1-LETTER " expected, not a string: 10"))
|
||||
(htdp-err/rt-test (string->int 10)
|
||||
(exn-type-and-msg exn:fail:contract? "string->int: expected a 1-letter string, but received a string: 10"))
|
||||
|
||||
(htdp-err/rt-test (string->int "AB") exn:fail:contract?
|
||||
#;
|
||||
(string-append
|
||||
"string->int: " 1-LETTER " expected, given " (format "~s" "AB")))
|
||||
(htdp-err/rt-test (string->int "AB")
|
||||
(exn-type-and-msg exn:fail:contract? "string->int: expected a 1-letter string, but received \"AB\""))
|
||||
|
||||
(htdp-test (list "h" "e" "l" "l" "o") 'explode (explode "hello"))
|
||||
|
||||
(htdp-err/rt-test (explode 10) exn:fail:contract?
|
||||
#;
|
||||
(string-append "explode: <string> expected, given " "10"))
|
||||
(htdp-err/rt-test (explode 10)
|
||||
(exn-type-and-msg exn:fail:contract? "explode: expected a string, but received 10"))
|
||||
|
||||
(htdp-test "hello" 'implode (implode (list "h" "e" "l" "l" "o")))
|
||||
|
||||
(htdp-err/rt-test (implode 10) exn:fail:contract?
|
||||
#;
|
||||
(string-append "implode: " 1-LETTER* " expected, not a <list>: 10"))
|
||||
(htdp-err/rt-test (implode 10)
|
||||
(exn-type-and-msg exn:fail:contract? "implode: expected a list of 1-letter strings, but received: 10"))
|
||||
|
||||
(htdp-err/rt-test (implode (list "he" "l"))
|
||||
(exn-type-and-msg exn:fail:contract? "implode: expected a list of 1-letter strings, but received '(\"he\" \"l\")"))
|
||||
|
||||
(htdp-err/rt-test (implode (list "he" "l")) exn:fail:contract?
|
||||
#;
|
||||
(string-append "implode: " 1-LETTER* " expected, given "
|
||||
(format "~s" (list "he" "l"))))
|
||||
|
||||
(htdp-test true 'string-numeric? (string-numeric? "0"))
|
||||
(htdp-test true 'string-numeric? (string-numeric? "10"))
|
||||
(htdp-test false 'string-numeric? (string-numeric? "a"))
|
||||
(htdp-test false 'string-numeric? (string-numeric? "ab"))
|
||||
|
||||
(htdp-err/rt-test (string-numeric? 10) exn:fail:contract?
|
||||
#;
|
||||
(string-append "string-numeric?: <string> expected, given 10"))
|
||||
|
||||
(htdp-err/rt-test (string-numeric? 10)
|
||||
(exn-type-and-msg exn:fail:contract? "string-numeric?: expected a string, but received 10"))
|
||||
|
||||
(htdp-test false 'string-alphabetic? (string-alphabetic? "a0"))
|
||||
(htdp-test true 'string-alphabetic? (string-alphabetic? "a"))
|
||||
|
|
|
|||
|
|
@ -1,14 +1,14 @@
|
|||
|
||||
(htdp-syntax-test #'(local [(define x 5)] x))
|
||||
(htdp-syntax-test #'(recur name ([x 18]) x))
|
||||
(htdp-syntax-test #'(local [(define x 5)] x) "local: this function is not defined")
|
||||
(htdp-syntax-test #'(recur name ([x 18]) x) "recur: this function is not defined")
|
||||
|
||||
(htdp-syntax-test #'(define (f78 a) (a))) ; no functions as arguments
|
||||
(htdp-syntax-test #'(define (f78 a) (a)) "function call: expected a function after the open parenthesis, but found a variable")
|
||||
|
||||
;; See htdp-top uses in beg-adv.rkt:
|
||||
(htdp-error-test #'f)
|
||||
(htdp-error-test #'(x 1))
|
||||
(htdp-error-test #'(+ f 1))
|
||||
(htdp-error-test #'((f 1)))
|
||||
(htdp-error-test #'((f 1)) )
|
||||
(htdp-error-test #'a1)
|
||||
(htdp-error-test #'make-a1)
|
||||
(htdp-error-test #'a1?)
|
||||
|
|
@ -24,7 +24,7 @@
|
|||
(htdp-top-pop 1)
|
||||
|
||||
(htdp-top (define (my-f x) (+ x 5)))
|
||||
(htdp-syntax-test #'my-f #rx"a procedure, so it must be applied")
|
||||
(htdp-syntax-test #'my-f #rx"found a use that does not follow an open parenthesis")
|
||||
(htdp-top-pop 1)
|
||||
|
||||
;; Teachpacks with higher-order primitives
|
||||
|
|
@ -34,13 +34,13 @@
|
|||
(htdp-top (define (my-f x) x))
|
||||
(htdp-top (define-struct foo (a b)))
|
||||
|
||||
(htdp-syntax-test #'(go 5 8))
|
||||
(htdp-syntax-test #'(go add1 add1))
|
||||
(htdp-syntax-test #'(go my-f add1))
|
||||
(htdp-syntax-test #'(go foo? add1))
|
||||
(htdp-syntax-test #'(go make-foo add1))
|
||||
(htdp-syntax-test #'(go foo-a add1))
|
||||
(htdp-syntax-test #'(go go add1))
|
||||
(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-top-pop 1)
|
||||
(htdp-teachpack-pop)
|
||||
|
|
|
|||
|
|
@ -1,12 +1,14 @@
|
|||
|
||||
;; For every test here, make sure the opposite test is in intml-adv.rkt
|
||||
|
||||
(htdp-syntax-test #'(1 2 3))
|
||||
(htdp-syntax-test #'("hello" 1 2))
|
||||
(htdp-syntax-test #'(1 2 3) "function call: expected a function after the open parenthesis, but found a number")
|
||||
(htdp-syntax-test #'("hello" 1 2) "function call: expected a function after the open parenthesis, but found a string")
|
||||
|
||||
(htdp-syntax-test #'(define x17 (lambda (y) (lambda (z) z))) "lambda: found a lambda that is not a function definition")
|
||||
(htdp-syntax-test #'(lambda (x) 10) "lambda: found a lambda that is not a function definition")
|
||||
|
||||
(htdp-syntax-test #'(define x17 (lambda (y) (lambda (z) z))))
|
||||
(htdp-syntax-test #'(lambda (x) 10))
|
||||
(htdp-syntax-test #'(lambda (f) (f f)) "lambda: found a lambda that is not a function definition")
|
||||
|
||||
(htdp-syntax-test #'(lambda (f) (f f)))
|
||||
(htdp-syntax-test #'(recur empty-f () 10) "recur: this function is not defined")
|
||||
|
||||
(htdp-syntax-test #'((unquote-splicing (list 10))) "function call: expected a function after the open parenthesis, but found a part")
|
||||
|
|
|
|||
|
|
@ -1,5 +1,8 @@
|
|||
|
||||
;; For every test here, make sure the opposite test is in advanced.rkt
|
||||
|
||||
(htdp-syntax-test #'(define (xthnk) 10))
|
||||
(htdp-syntax-test #'(define xthnk (lambda () 10)))
|
||||
(htdp-syntax-test #'(define (xthnk) 10) "define: expected at least one variable after the function name, but found none")
|
||||
(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:")
|
||||
|
|
|
|||
|
|
@ -16,17 +16,16 @@
|
|||
(htdp-test '(quasiquote (unquote 22)) 'qq ``,,(* 11 2))
|
||||
(htdp-test '(quasiquote ((unquote-splicing (22)))) 'qq ``(,@(,@(list (* 11 2)))))
|
||||
|
||||
(htdp-syntax-test #'quasiquote)
|
||||
(htdp-syntax-test #'`unquote)
|
||||
(htdp-syntax-test #'`unquote-splicing)
|
||||
(htdp-syntax-test #'`(unquote-splicing 10))
|
||||
(htdp-syntax-test #'quasiquote "quasiquote: found a use that does not precede an open parenthesis")
|
||||
(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")
|
||||
|
||||
(htdp-syntax-test #'unquote)
|
||||
(htdp-syntax-test #'(unquote))
|
||||
(htdp-syntax-test #'(unquote 10))
|
||||
(htdp-syntax-test #'unquote "unquote: misuse of a comma or unquote, not under a quasiquoting backquote")
|
||||
(htdp-syntax-test #'(unquote) "unquote: misuse of a comma or unquote, not under a quasiquoting backquote")
|
||||
(htdp-syntax-test #'(unquote 10) "unquote: misuse of a comma or unquote, not under a quasiquoting backquote")
|
||||
|
||||
(htdp-syntax-test #'unquote-splicing)
|
||||
(htdp-syntax-test #'(unquote-splicing (list 10)))
|
||||
(htdp-syntax-test #'((unquote-splicing (list 10))))
|
||||
(htdp-syntax-test #'unquote-splicing "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
|
||||
(htdp-syntax-test #'(unquote-splicing (list 10)) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
|
||||
|
||||
(htdp-err/rt-test `(,@4))
|
||||
(htdp-err/rt-test `(,@4) (exn-type-and-msg exn:fail:contract? "append: expected argument of type <proper list>; given 4"))
|
||||
|
|
|
|||
|
|
@ -91,11 +91,11 @@
|
|||
(load-relative "beg-intm.rktl")
|
||||
(load-relative "beg-bega.rktl")
|
||||
|
||||
(htdp-syntax-test #'quote)
|
||||
(htdp-syntax-test #''1)
|
||||
(htdp-syntax-test #''"hello")
|
||||
(htdp-syntax-test #''(1 2))
|
||||
(htdp-syntax-test #'''a)
|
||||
(htdp-syntax-test #'quote "found a use that isn't before a parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'''a "quote: expected the name of the symbol after the quote, but found a part")
|
||||
|
||||
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@
|
|||
#,(strip-context stx))
|
||||
(lambda (x)
|
||||
(and (exn:fail:syntax? x)
|
||||
(regexp-match rx (exn-message x)))))]))
|
||||
(regexp-match (if (string? rx) (regexp-quote rx) rx) (exn-message x)))))]))
|
||||
|
||||
(require (only-in mzscheme
|
||||
[let mz-let]
|
||||
|
|
@ -106,6 +106,12 @@
|
|||
[(_ expr exn?)
|
||||
#'(do-htdp-test #'expr #f (htdp-string-to-pred exn?))]))
|
||||
|
||||
(define (exn-type-and-msg type-pred msg)
|
||||
(lambda (exn)
|
||||
(and (type-pred exn)
|
||||
(regexp-match (if (string? msg) (regexp-quote msg) msg) (exn-message exn)))))
|
||||
|
||||
|
||||
(define (htdp-error-test stx)
|
||||
(do-htdp-test stx #t #f))
|
||||
|
||||
|
|
|
|||
|
|
@ -32,4 +32,6 @@
|
|||
(load-relative "intm-intml.rktl")
|
||||
(load-relative "intm-adv.rktl")
|
||||
|
||||
(htdp-syntax-test #'(local [(lambda (x) x)] 1) "lambda: found a lambda that is not a function definition")
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
|
|
@ -2,20 +2,21 @@
|
|||
;; These are true for beginner, but the operators are syntax, so
|
||||
;; arity-test doesn't work.
|
||||
|
||||
(htdp-syntax-test #'local)
|
||||
(htdp-syntax-test #'(local))
|
||||
(htdp-syntax-test #'(local ()))
|
||||
(htdp-syntax-test #'(local 1))
|
||||
(htdp-syntax-test #'(local 1 1))
|
||||
(htdp-syntax-test #'(local () 1 2))
|
||||
(htdp-syntax-test #'(local [1] 1 2))
|
||||
(htdp-syntax-test #'(local [(+ 1 2)] 1))
|
||||
(htdp-syntax-test #'(local [(define x)] 1))
|
||||
(htdp-syntax-test #'(local [(lambda (x) x)] 1))
|
||||
(htdp-syntax-test #'(local [(define x 1) (define x 2)] 1))
|
||||
(htdp-syntax-test #'(local [(define (x a) 12) (+ 1 2)] 1))
|
||||
(htdp-syntax-test #'local "local: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(local 1 1) "local: expected at least one definition (in square brackets) after local, but found a number")
|
||||
(htdp-syntax-test #'(local () 1 2) "local: expected only one expression after the local definitions, but found 1 extra part")
|
||||
(htdp-syntax-test #'(local [1] 1 2) "local: expected a definition, but found a number")
|
||||
(htdp-syntax-test #'(local [(+ 1 2)] 1) "local: expected a definition, but found a part")
|
||||
(htdp-syntax-test #'(local [(define x)] 1) "define: expected an expression after the variable name x, but nothing's there")
|
||||
(htdp-syntax-test #'(local [(define x 1) (define x 2)] 1) "local: x was defined locally more than once")
|
||||
(htdp-syntax-test #'(local [(define (x a) 12) (+ 1 2)] 1) "local: expected a definition, but found a part")
|
||||
|
||||
(htdp-err/rt-test (local [(define x y) (define y 5)] 10) exn:fail:contract:variable?)
|
||||
(htdp-err/rt-test (local [(define x y) (define y 5)] 10)
|
||||
(exn-type-and-msg exn:fail:contract:variable?
|
||||
"local variable used before its definition: y"))
|
||||
|
||||
(htdp-test 1 'local (local () 1))
|
||||
(htdp-test 5 'local (local [(define y 5) (define x y)] x))
|
||||
|
|
@ -25,22 +26,24 @@
|
|||
(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)
|
||||
(htdp-syntax-test #'(letrec))
|
||||
(htdp-syntax-test #'(letrec ()))
|
||||
(htdp-syntax-test #'(letrec 1 2))
|
||||
(htdp-syntax-test #'(letrec 1 2 3))
|
||||
(htdp-syntax-test #'(letrec (10) 1))
|
||||
(htdp-syntax-test #'(letrec ([x]) 1))
|
||||
(htdp-syntax-test #'(letrec ([x 2 3]) 1))
|
||||
(htdp-syntax-test #'(letrec ([x 5] 10) 1))
|
||||
(htdp-syntax-test #'(letrec ([1 5]) 1))
|
||||
(htdp-syntax-test #'(letrec ([1 5 6]) 1))
|
||||
(htdp-syntax-test #'(letrec ([x 5]) 1 2))
|
||||
(htdp-syntax-test #'(letrec ([x 5][x 6]) 1))
|
||||
|
||||
(htdp-err/rt-test (letrec ([x y] [y 5]) 10) exn:fail:contract:variable?)
|
||||
(htdp-syntax-test #'letrec "letrec: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(letrec 1 2 3) "letrec: expected at least one binding (in parentheses) after letrec, but found a number")
|
||||
(htdp-syntax-test #'(letrec (10) 1) "letrec: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(letrec ([x]) 1) "letrec: expected an expression after the name x, but nothing's there")
|
||||
(htdp-syntax-test #'(letrec ([x 2 3]) 1) "letrec: expected only one expression after the name x, but found 1 extra part")
|
||||
(htdp-syntax-test #'(letrec ([x 5] 10) 1) "letrec: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(letrec ([1 5]) 1) "letrec: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(letrec ([1 5 6]) 1) "letrec: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(letrec ([x 5]) 1 2) "letrec: expected only one expression after the bindings, but found 1 extra part")
|
||||
(htdp-syntax-test #'(letrec ([x 5][x 6]) 1) "letrec: x was defined locally more than once")
|
||||
|
||||
(htdp-err/rt-test (letrec ([x y] [y 5]) 10)
|
||||
(exn-type-and-msg exn:fail:contract:variable?
|
||||
"local variable used before its definition: y"))
|
||||
|
||||
(htdp-test 1 'letrec (letrec () 1))
|
||||
(htdp-test 5 'letrec (letrec ([y 5][x y]) x))
|
||||
(htdp-test #t 'letrec (letrec ([even (lambda (n) (if (zero? n) true (odd (sub1 n))))]
|
||||
|
|
@ -49,19 +52,19 @@
|
|||
(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)
|
||||
(htdp-syntax-test #'(let))
|
||||
(htdp-syntax-test #'(let ()))
|
||||
(htdp-syntax-test #'(let 1 2))
|
||||
(htdp-syntax-test #'(let 1 2 3))
|
||||
(htdp-syntax-test #'(let (10) 1))
|
||||
(htdp-syntax-test #'(let ([x]) 1))
|
||||
(htdp-syntax-test #'(let ([x 2 3]) 1))
|
||||
(htdp-syntax-test #'(let ([x 5] 10) 1))
|
||||
(htdp-syntax-test #'(let ([1 5]) 1))
|
||||
(htdp-syntax-test #'(let ([1 5 6]) 1))
|
||||
(htdp-syntax-test #'(let ([x 5]) 1 2))
|
||||
(htdp-syntax-test #'(let ([x 5][x 6]) 1))
|
||||
(htdp-syntax-test #'let "let: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(let 1 2 3) "let: expected at least one binding (in parentheses) after let, but found a number")
|
||||
(htdp-syntax-test #'(let (10) 1) "let: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(let ([x]) 1) "let: expected an expression after the name x, but nothing's there")
|
||||
(htdp-syntax-test #'(let ([x 2 3]) 1) "let: expected only one expression after the name x, but found 1 extra part" )
|
||||
(htdp-syntax-test #'(let ([x 5] 10) 1) "let: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(let ([1 5]) 1) "let: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(let ([1 5 6]) 1) "let: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(let ([x 5]) 1 2) "let: expected only one expression after the bindings, but found 1 extra part")
|
||||
(htdp-syntax-test #'(let ([x 5][x 6]) 1) "let: x was defined locally more than once")
|
||||
|
||||
(htdp-test 1 'let (let () 1))
|
||||
(htdp-test 5 'let (let ([y 5]) (let ([x y]) x)))
|
||||
|
|
@ -69,18 +72,18 @@
|
|||
(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*)
|
||||
(htdp-syntax-test #'(let*))
|
||||
(htdp-syntax-test #'(let* ()))
|
||||
(htdp-syntax-test #'(let* 1 2))
|
||||
(htdp-syntax-test #'(let* 1 2 3))
|
||||
(htdp-syntax-test #'(let* (10) 1))
|
||||
(htdp-syntax-test #'(let* ([x]) 1))
|
||||
(htdp-syntax-test #'(let* ([x 2 3]) 1))
|
||||
(htdp-syntax-test #'(let* ([x 5] 10) 1))
|
||||
(htdp-syntax-test #'(let* ([1 5]) 1))
|
||||
(htdp-syntax-test #'(let* ([1 5 6]) 1))
|
||||
(htdp-syntax-test #'(let* ([x 5]) 1 2))
|
||||
(htdp-syntax-test #'let* "let*: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
(htdp-syntax-test #'(let* 1 2 3) "let*: expected at least one binding (in parentheses) after let*, but found a number")
|
||||
(htdp-syntax-test #'(let* (10) 1) "let*: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(let* ([x]) 1) "let*: expected an expression after the name x, but nothing's there")
|
||||
(htdp-syntax-test #'(let* ([x 2 3]) 1) "let*: expected only one expression after the name x, but found 1 extra part")
|
||||
(htdp-syntax-test #'(let* ([x 5] 10) 1) "let*: expected a binding with a variable and an expression, but found a number")
|
||||
(htdp-syntax-test #'(let* ([1 5]) 1) "let*: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(let* ([1 5 6]) 1) "let*: expected a variable for the binding, but found a number")
|
||||
(htdp-syntax-test #'(let* ([x 5]) 1 2) "let*: expected only one expression after the bindings, but found 1 extra part")
|
||||
|
||||
(htdp-test 1 'let* (let* () 1))
|
||||
(htdp-test 6 'let* (let* ([x 5][x 6]) x))
|
||||
|
|
@ -91,24 +94,24 @@
|
|||
(htdp-test 16 'let* (let* ([f (lambda (x) (+ x 10))]) (f 6)))
|
||||
|
||||
(htdp-test 7779 'time (time 7779))
|
||||
(htdp-syntax-test #'time)
|
||||
(htdp-syntax-test #'(time))
|
||||
(htdp-syntax-test #'(time 1 2))
|
||||
(htdp-syntax-test #'(time (define x 5)))
|
||||
(htdp-syntax-test #'time "time: found a use that does not follow an open parenthesis")
|
||||
(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")
|
||||
|
||||
(htdp-err/rt-test (foldr car 2 '(1 2 3))
|
||||
"foldr : first argument must be a <procedure> that accepts two arguments, given #<procedure:car>")
|
||||
"foldr : first argument must be a function that expects two arguments, given")
|
||||
|
||||
(htdp-err/rt-test (foldl car 2 '(1 2 3))
|
||||
"foldl : first argument must be a <procedure> that accepts two arguments, given #<procedure:car>")
|
||||
"foldl : first argument must be a function that expects two arguments, given #<procedure:car>")
|
||||
|
||||
(htdp-err/rt-test (build-string 2 add1)
|
||||
"build-string : second argument must be a <procedure> that produces a <char>, given #<procedure:add1>, which produced 1 for 0")
|
||||
"build-string : the second argument must be a function that produces a character, given #<procedure:add1>, which produced 1 for 0")
|
||||
|
||||
(htdp-test 0 '+ (+))
|
||||
(htdp-test 1 '+ (+ 1))
|
||||
(htdp-test 1 '* (*))
|
||||
(htdp-test 1 '* (* 1))
|
||||
;(htdp-test (-) exn:application:arity?)
|
||||
;(htdp-err/rt-test (/) exn:application:arity?)
|
||||
(htdp-err/rt-test (-) (exn-type-and-msg exn:application:arity? "-: expects at least 1 argument, given 0"))
|
||||
(htdp-err/rt-test (/) (exn-type-and-msg exn:application:arity? "/: expects at least 1 argument, given 0"))
|
||||
;(htdp-test 1 (/ 1) exn:application:arity?)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
|
||||
(htdp-syntax-test #'(recur empty-f () 10))
|
||||
|
||||
(htdp-syntax-test #'(let name ([x 12]) 10))
|
||||
(htdp-syntax-test #'(let name ([x 12]) 10) "let: expected at least one binding (in parentheses) after let, but found something else")
|
||||
|
||||
|
|
|
|||
|
|
@ -12,5 +12,10 @@
|
|||
|
||||
(err/rt-test (1 2 3))
|
||||
|
||||
(htdp-syntax-test #'(recur empty-f () 10) "recur: expected a function name after recur, but nothing's there"
|
||||
(htdp-syntax-test #'(local [(lambda (x) x)] 1) "local: expected a definition, but found a part")
|
||||
|
||||
(htdp-syntax-test #'((unquote-splicing (list 10))) "unquote-splicing: misuse of ,@ or unquote-splicing, not under a quasiquoting backquote")
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -175,7 +175,9 @@ transcript.
|
|||
(printf " WRONG EXN ELEM ~s: ~s " sel e)
|
||||
(record-error (list e (cons 'exn-elem sel) expr)))))))
|
||||
exn-table)
|
||||
|
||||
|
||||
(printf "~s~n" (if (exn? e) (exn-message e) e))
|
||||
#; ;g;
|
||||
((error-display-handler)
|
||||
(if (exn? e)
|
||||
(exn-message e)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user