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

signal error when attempting to generate from a

Browse Source 
metafunction with no cases

closes PR 13536
This commit is contained in:
Robby Findler 2013-02-19 22:07:43 -06:00
parent c6f106d285
commit 2f50cde745
2 changed files with 17 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/redex/private/generate-term.rkt
View File

@ -377,9 +377,11 @@
=> (λ (f)
#`(let* ([f #,f]
[L (metafunc-proc-lang f)]
[compile-pat (compile L '#,form-name)])
[compile-pat (compile L '#,form-name)]
[cases (metafunc-proc-cases f)])
(check-cases 'src cases)
(map (λ (c) (compile-pat ((metafunc-case-lhs+ c) L)))
(metafunc-proc-cases f))))]
cases)))]
[else
#`(let* ([r #,(apply-contract #'reduction-relation? #'src "#:source argument" form-name)]
[L (reduction-relation-lang r)]
@ -403,6 +405,10 @@
(quasisyntax/loc stx
(#,generator-syntax size . kw-args))]))]))
(define (check-cases name cases)
(when (null? cases)
(raise-gen-fail 'generate-term (format "from ~a metafunction (it has no clauses)" name) 1)))
(define-syntax (generate-mf-pat stx)
(syntax-case stx ()
[(g-m-p lang-id (mf-name . lhs-pats) rhs-pat size)

10
collects/redex/tests/rg-test.rkt
View File

@ -1227,7 +1227,15 @@
(test (raised-exn-msg
exn:fail:redex:generation-failure?
(check-metafunction n (λ (_) #t) #:retries 42))
#rx"check-metafunction: unable .* in 42"))
#rx"check-metafunction: unable .* in 42")
(let ()
(define-metafunction empty bogo : any -> any)
(test (raised-exn-msg
exn:fail:redex:generation-failure?
(generate-term #:source bogo 5))
#rx"unable.*bogo")))
(let ()
(define-language lang (x variable))