From 0c13f4d0e71a9f368a02f35f70ec6c0701bbf099 Mon Sep 17 00:00:00 2001
From: chaosii <yixin.cao@polyu.edu.hk>
Date: Thu, 17 Jan 2008 02:59:49 +0000
Subject: extend the case.spad case.input to test the whole Syntax domain.

---
 src/testsuite/interpreter/testSyntax.input |  7 ++++
 src/testsuite/interpreter/testSyntax.spad  | 53 ++++++++++++++++++++++++++++++
 2 files changed, 60 insertions(+)
 create mode 100644 src/testsuite/interpreter/testSyntax.input
 create mode 100644 src/testsuite/interpreter/testSyntax.spad

(limited to 'src/testsuite/interpreter')

diff --git a/src/testsuite/interpreter/testSyntax.input b/src/testsuite/interpreter/testSyntax.input
new file mode 100644
index 00000000..fdcbabdb
--- /dev/null
+++ b/src/testsuite/interpreter/testSyntax.input
@@ -0,0 +1,7 @@
+++ Contributed by Yixin Cao
+)co "syntax.spad"
+sym:=("b")::Symbol
+syn:=b::Syntax
+test syn
+
+test()
diff --git a/src/testsuite/interpreter/testSyntax.spad b/src/testsuite/interpreter/testSyntax.spad
new file mode 100644
index 00000000..9cd16c21
--- /dev/null
+++ b/src/testsuite/interpreter/testSyntax.spad
@@ -0,0 +1,53 @@
+++ Contibuted by Yixin Cao
+)abbrev domain TD TestDomain
+import OutputPackage
+TestDomain :Public == Private where
+  Public == with
+    testCase: Syntax -> Boolean
+    testCoerceTo: Symbol -> Syntax
+    testCoerceFrom: Syntax -> Symbol
+    testBuildSyntax: () -> Syntax
+    testGetOperator: Syntax -> Syntax
+    testGetOperator: () -> Syntax
+    test: Syntax -> Boolean
+    test: () -> Boolean
+
+  Private == add
+    testBuildSyntax ==
+      b:=("b")::Symbol
+      a:=("a")::Symbol
+      m:=("-")::Symbol
+      c:=buildSyntax('_*, [a::Syntax, 3::Syntax])
+      d:=buildSyntax(m::Syntax, [b::Syntax, c])
+      d:=buildSyntax('_-, [3::Syntax, 2::Syntax])
+      d
+
+    testCase(x) ==
+      x case Symbol
+
+    testCoerceFrom x ==
+      x case Symbol => coerce(x)@Symbol
+
+    testCoerceTo s ==
+      error "not implemented yet"
+
+    testGetOperator  ==
+      (getOperator testBuildSyntax())::Syntax    
+
+    test ==
+      test testBuildSyntax()
+
+    test x ==
+      output "testing case function"
+      testCase x
+      output "case function works"
+
+      output "testing coerce from Syntax to Symbol"
+      testCoerceFrom x
+      output "coerce (from) function works"
+
+      output "testing getOperator function"
+      testGetOperator()
+      output "getOperator function works"
+
+      true
-- 
cgit v1.2.3