diff --git a/collects/redex/private/generate-term.rkt b/collects/redex/private/generate-term.rkt index 6befebe3e9..3a4f31a094 100644 --- a/collects/redex/private/generate-term.rkt +++ b/collects/redex/private/generate-term.rkt @@ -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) diff --git a/collects/redex/tests/rg-test.rkt b/collects/redex/tests/rg-test.rkt index d7a7730c6a..3f7a5fa107 100644 --- a/collects/redex/tests/rg-test.rkt +++ b/collects/redex/tests/rg-test.rkt @@ -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))