From ecdd50da094872ede7c2a8e829806fa0e188cd5e Mon Sep 17 00:00:00 2001
From: Casey Klein <clklein@racket-lang.org>
Date: Tue, 30 Aug 2011 13:07:13 -0500
Subject: [PATCH] Tests defined-checks directly

---
 collects/redex/tests/defined-checks-test.rkt  | 24 +++++++++++++++++++
 .../run-err-tests/metafunction-undefined.rktd |  8 +++++++
 collects/redex/tests/run-tests.rkt            |  1 +
 collects/redex/tests/tl-test.rkt              |  4 ++++
 4 files changed, 37 insertions(+)
 create mode 100644 collects/redex/tests/defined-checks-test.rkt
 create mode 100644 collects/redex/tests/run-err-tests/metafunction-undefined.rktd

diff --git a/collects/redex/tests/defined-checks-test.rkt b/collects/redex/tests/defined-checks-test.rkt
new file mode 100644
index 0000000000..c2d4b84e0f
--- /dev/null
+++ b/collects/redex/tests/defined-checks-test.rkt
@@ -0,0 +1,24 @@
+#lang racket
+
+(require "test-util.rkt"
+         "../private/error.rkt"
+         "../private/defined-checks.rkt")
+
+(reset-count)
+
+(define expected-message "reference to thing x before its definition")
+
+(test (with-handlers ([exn:fail:redex? exn-message])
+        (check-defined-lexical x 'x "thing")
+        (define x 4)
+        "")
+      expected-message)
+
+(test (with-handlers ([exn:fail:redex? exn-message])
+        (check-defined-module (λ () x) 'x "thing")
+        "")
+      expected-message)
+
+(define x 4)
+
+(print-tests-passed 'defined-checks-test.rkt)
\ No newline at end of file
diff --git a/collects/redex/tests/run-err-tests/metafunction-undefined.rktd b/collects/redex/tests/run-err-tests/metafunction-undefined.rktd
new file mode 100644
index 0000000000..a01c78b7f6
--- /dev/null
+++ b/collects/redex/tests/run-err-tests/metafunction-undefined.rktd
@@ -0,0 +1,8 @@
+("reference to metafunction q before its definition"
+ ([use q]) ([def q])
+ (let ()
+   (term (use))
+   (define-language L)
+   (define-metafunction L
+     [(def) ()])
+   #f))
\ No newline at end of file
diff --git a/collects/redex/tests/run-tests.rkt b/collects/redex/tests/run-tests.rkt
index bca1653099..d70ccd71cf 100644
--- a/collects/redex/tests/run-tests.rkt
+++ b/collects/redex/tests/run-tests.rkt
@@ -26,6 +26,7 @@
      "pict-test.rkt"
      "hole-test.rkt"
      "stepper-test.rkt"
+     "defined-checks-test.rkt"
      "check-syntax-test.rkt"
      "test-docs-complete.rkt")
    (if test-bitmaps? '("bitmap-test.rkt") '())
diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt
index 2b3bbf992a..9b31935a95 100644
--- a/collects/redex/tests/tl-test.rkt
+++ b/collects/redex/tests/tl-test.rkt
@@ -977,6 +977,10 @@
                  x)
           '(2 1)))
   
+  (parameterize ([current-namespace (make-base-namespace)])
+    (eval '(require redex/reduction-semantics))
+    (exec-runtime-error-tests "run-err-tests/judgment-form-undefined.rktd"))
+  
   ;; errors for not-yet-defined metafunctions
   (test (parameterize ([current-namespace (make-empty-namespace)])
           (namespace-attach-module (namespace-anchor->namespace this-namespace) 'redex/reduction-semantics)