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

PR 10650

Browse Source 
svn: r17331
This commit is contained in:
Casey Klein 2009-12-16 20:46:58 +00:00
parent 9e6e9696af
commit eb4403f1c7
2 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/redex/private/reduction-semantics.ss
View File

@ -936,7 +936,7 @@
other-matches)))))
(rewrite-proc-name child-make-proc)
(λ (lang) (subst lhs-frm-id ((rewrite-proc-lhs child-make-proc) lang) rhs-from))
(rewrite-proc-lhs child-make-proc)
(rewrite-proc-lhs-src child-make-proc)
(rewrite-proc-id child-make-proc)))
(define relation-coverage (make-parameter null))

44
collects/redex/private/rg-test.ss
View File

@ -699,26 +699,32 @@
exn:fail:redex:generation-failure?
(redex-check lang (side-condition any #f) #t #:retries 42 #:attempts 1))
#rx"^redex-check: unable .* in 42")
(let-syntax ([test-gen-fail
(syntax-rules ()
[(_ rhs expected)
(test
(raised-exn-msg
exn:fail:redex:generation-failure?
(redex-check lang any #t
#:source (reduction-relation
lang
rhs)
#:retries 42
#:attempts 1))
expected)])])
(test-gen-fail
(--> (side-condition any #f) any)
#px"^redex-check: unable to generate LHS of clause at .*:\\d+:\\d+ in 42")
(let ([unable-loc #px"^redex-check: unable to generate LHS of clause at .*:\\d+:\\d+ in 42"])
(let-syntax ([test-gen-fail
(syntax-rules ()
[(_ clauses ... expected)
(test
(raised-exn-msg
exn:fail:redex:generation-failure?
(redex-check lang any #t
#:source (reduction-relation
lang
clauses ...)
#:retries 42
#:attempts 1))
expected)])])
(test-gen-fail
(--> (side-condition any #f) any)
unable-loc)
(test-gen-fail
(--> (side-condition any #f) any impossible)
#rx"^redex-check: unable to generate LHS of impossible in 42")))
(test-gen-fail
(==> (side-condition any #f) any)
with [(--> a b) (==> a b)]
unable-loc)
(test-gen-fail
(--> (side-condition any #f) any impossible)
#rx"^redex-check: unable to generate LHS of impossible in 42"))))
;; check-metafunction-contract
(let ()