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

improve error reporting ands doc for check-expect (PR 9499 and 9500)

Browse Source 
svn: r10257
This commit is contained in:
Matthew Flatt 2008-06-13 17:24:24 +00:00
parent 63311353d7
commit 938df1800c
7 changed files with 47 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
collects/scribblings/htdp-langs/advanced.scrbl
View File

@ -39,9 +39,11 @@
#:literals (define define-struct lambda cond else if and or empty true false require lib planet
local let let* letrec time begin begin0 set! delay shared recur when case unless
check-expect check-within check-error)
(check-expect check-within check-error require)
[program (code:line def-or-expr ...)]
[def-or-expr definition
expr
test-case
library-require]
[definition (define (id id id ...) expr)
(define id expr)
@ -71,7 +73,6 @@
(and expr expr expr ...)
(or expr expr expr ...)
(time expr)
test-case
empty
(code:line id (code:comment #, @seclink["intermediate-id"]{identifier}))
(code:line prim-op (code:comment #, @seclink["intermediate-lambda-prim-op"]{primitive operation}))

3
collects/scribblings/htdp-langs/beginner-abbr.scrbl
View File

@ -25,9 +25,11 @@
@schemegrammar*+qq[
#:literals (define define-struct lambda cond else if and or empty true false require lib planet
check-expect check-within check-error)
(check-expect check-within check-error require)
[program (code:line def-or-expr ...)]
[def-or-expr definition
expr
test-case
library-require]
[definition (define (id id id ...) expr)
(define id expr)
@ -40,7 +42,6 @@
(if expr expr expr)
(and expr expr expr ...)
(or expr expr expr ...)
test-case
empty
id
(code:line #, @elem{@schemevalfont{'}@scheme[quoted]} (code:comment #, @seclink["beginner-abbr-quote"]{quoted value}))

4
collects/scribblings/htdp-langs/beginner.scrbl
View File

@ -12,10 +12,11 @@
@schemegrammar*+library[
#:literals (define define-struct lambda cond else if and or empty true false require lib planet
check-expect check-within check-error)
(check-expect check-within check-error require)
[program (code:line def-or-expr ...)]
[def-or-expr definition
expr
test-case
library-require]
[definition (define (id id id ...) expr)
(define id expr)
@ -28,7 +29,6 @@
(if expr expr expr)
(and expr expr expr ...)
(or expr expr expr ...)
test-case
empty
id
(code:line id (code:comment #, @seclink["beginner-id"]{identifier}))

3
collects/scribblings/htdp-langs/intermediate-lambda.scrbl
View File

@ -37,9 +37,11 @@
@schemegrammar*+qq[
#:literals (define define-struct lambda cond else if and or empty true false require lib planet
local let let* letrec time check-expect check-within check-error)
(check-expect check-within check-error require)
[program (code:line def-or-expr ...)]
[def-or-expr definition
expr
test-case
library-require]
[definition (define (id id id ...) expr)
(define id expr)
@ -56,7 +58,6 @@
(and expr expr expr ...)
(or expr expr expr ...)
(time expr)
test-case
empty
(code:line id (code:comment #, @seclink["intermediate-id"]{identifier}))
(code:line prim-op (code:comment #, @seclink["intermediate-lambda-prim-op"]{primitive operation}))

3
collects/scribblings/htdp-langs/intermediate.scrbl
View File

@ -24,9 +24,11 @@
@schemegrammar*+qq[
#:literals (define define-struct lambda cond else if and or empty true false require lib planet
local let let* letrec time check-expect check-within check-error)
(check-expect check-within check-error require)
[program (code:line def-or-expr ...)]
[def-or-expr definition
expr
test-case
library-require]
[definition (define (id id id ...) expr)
(define id expr)
@ -44,7 +46,6 @@
(and expr expr expr ...)
(or expr expr expr ...)
(time expr)
test-case
empty
(code:line id (code:comment #, @seclink["intermediate-id"]{identifier}))
(code:line prim-op (code:comment #, @seclink["intermediate-prim-op"]{primitive operation}))

19
collects/scribblings/htdp-langs/std-grammar.ss
View File

@ -10,21 +10,30 @@
(define ex-str "This is a string with \" inside")
(define-syntax-rule (schemegrammar*+library form ...)
(define-syntax-rule (schemegrammar*+library
#:literals lits
(check-expect check-within check-error require)
form ...)
(schemegrammar*
#:literals lits
form ...
[test-case #, @scheme[(check-expect expr expr)]
#, @scheme[(check-within expr expr expr)]
#, @scheme[(check-error expr expr)]]
(...
[libray-require #, @scheme[(require string)]
#, @scheme[(require (lib string string ...))]
#, @scheme[(require (planet string package))]])
[library-require #, @scheme[(require string)]
#, @scheme[(require (lib string string ...))]
#, @scheme[(require (planet string package))]])
(...
[package #, @scheme[(string string number number)]])))
(define-syntax-rule (schemegrammar*+qq form ...)
(define-syntax-rule (schemegrammar*+qq
#:literals lits
(check-expect check-within check-error require)
form ...)
(schemegrammar*+library
#:literals lits
(check-expect check-within check-error require)
form ...
(...
[quoted id

39
collects/test-engine/scheme-tests.ss
View File

@ -30,11 +30,11 @@
"check-within requires three expressions. Try (check-within test expected range).")
(define-for-syntax CHECK-EXPECT-DEFN-STR
"check-expect cannot be used as an expression")
"found a test that is not at the top level")
(define-for-syntax CHECK-WITHIN-DEFN-STR
"check-within cannot be used as an expression")
CHECK-EXPECT-DEFN-STR)
(define-for-syntax CHECK-ERROR-DEFN-STR
"check-error cannot be used as an expression")
CHECK-EXPECT-DEFN-STR)
(define-struct check-fail (src))
@ -84,21 +84,24 @@
'(syntax-e cdr cdr syntax-e car) ;; lambda
))))))
(define-for-syntax (check-context?)
(let ([c (syntax-local-context)])
(memq c '(module top-level))))
;; check-expect
(define-syntax (check-expect stx)
(syntax-case stx ()
[(_ test actual)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(check-expect-maker stx #'check-values-expected (list #`(lambda () test) #`actual) 'comes-from-check-expect)]
[(_ test)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)]
[(_ test actual extra ...)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-expect CHECK-EXPECT-STR stx)]
[(_ test ...)
(eq? (syntax-local-context) 'expression)
(not (check-context?))
(raise-syntax-error 'check-expect CHECK-EXPECT-DEFN-STR stx)]))
;; check-values-expected: (-> scheme-val) scheme-val src -> void
@ -113,19 +116,19 @@
(define-syntax (check-within stx)
(syntax-case stx ()
[(_ test actual within)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(check-expect-maker stx #'check-values-within (list #`(lambda () test) #`actual #`within) 'comes-from-check-within)]
[(_ test actual)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]
[(_ test)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]
[(_ test actual within extra ...)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-within CHECK-WITHIN-STR stx)]
[(_ test ...)
(eq? (syntax-local-context) 'expression)
(not (check-context?))
(raise-syntax-error 'check-within CHECK-WITHIN-DEFN-STR stx)]))
(define (check-values-within test actual within src test-info)
@ -139,13 +142,13 @@
(define-syntax (check-error stx)
(syntax-case stx ()
[(_ test error)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(check-expect-maker stx #'check-values-error (list #'(lambda () test) #`error) 'comes-from-check-error)]
[(_ test)
(not (eq? (syntax-local-context) 'expression))
(check-context?)
(raise-syntax-error 'check-error CHECK-ERROR-STR stx)]
[(_ test ...)
(eq? (syntax-local-context) 'expression)
(not (check-context?))
(raise-syntax-error 'check-error CHECK-ERROR-DEFN-STR stx)]))
(define (check-values-error test error src test-info)
@ -162,7 +165,11 @@
(begin
(send (send test-info get-info) check-failed
(check->message result) (check-fail-src result))
(list 'check-error-failed (incorrect-error-message result) error))
(list 'check-error-failed
(if (expected-error? result)
(expected-error-message result)
(incorrect-error-message result))
error))
(list 'check-error-succeeded error error))))