From 084e3c400410e954b633a07c98f32ecfa62f1ec8 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 26 Apr 2019 21:37:40 -0400
Subject: Ported reference tests.

---
 .../spec/compositor/generation/reference.lux       | 56 ++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 stdlib/source/spec/compositor/generation/reference.lux

(limited to 'stdlib/source/spec/compositor')

diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux
new file mode 100644
index 000000000..35de4e8ef
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/reference.lux
@@ -0,0 +1,56 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." error]]
+   [tool
+    [compiler
+     ["." reference]
+     ["." synthesis]]]
+   [math
+    ["r" random (#+ Random)]]]
+  ["." ///])
+
+(def: name
+  (Random Name)
+  (let [name-part (r.ascii/upper-alpha 5)]
+    [(r.and name-part name-part)]))
+
+(def: (definition define)
+  (-> ///.Definer Test)
+  (do r.monad
+    [name ..name
+     expected r.safe-frac]
+    (_.test "Definitions."
+            (|> (define name (synthesis.f64 expected))
+                (case> (#error.Success actual)
+                       (f/= expected (:coerce Frac actual))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: (variable run)
+  (-> ///.Runner Test)
+  (do r.monad
+    [register (|> r.nat (:: @ map (n/% 100)))
+     expected r.safe-frac]
+    (_.test "Local variables."
+            (|> (synthesis.branch/let [(synthesis.f64 expected)
+                                       register
+                                       (synthesis.variable/local register)])
+                (run "variable")
+                (case> (#error.Success actual)
+                       (f/= expected (:coerce Frac actual))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: #export (spec runner definer)
+  (-> ///.Runner ///.Definer Test)
+  ($_ _.and
+      (..definition definer)
+      (..variable runner)))
-- 
cgit v1.2.3