From 2f50cde745657a378b16bedc4fdba15a46be884e Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 19 Feb 2013 22:07:43 -0600
Subject: [PATCH] signal error when attempting to generate from a metafunction
 with no cases

closes PR 13536
---
 collects/redex/private/generate-term.rkt | 10 ++++++++--
 collects/redex/tests/rg-test.rkt         | 10 +++++++++-
 2 files changed, 17 insertions(+), 3 deletions(-)

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))