Added tests for core-form parsing function

diff --git a/source/parser.scm b/source/parser.scm
index 161b98923312aa4284d3c1fc8299ae6d5ee1724f..57e240546d400c467741cc9e6003b24f1c5d2f7c 100644 (file)
--- a/source/parser.scm
+++ b/source/parser.scm
@@ -47,18 +47,23 @@
 
 (define (dlang/core-form in)
   (define tok (buf-lookahead! in 1))
-  (cond (token-text tok)
-    (("def")   (dlang/define in))
-    (("set!")  (dlang/assign in))
-    (("if")    (dlang/if in))
-    (("begin") (dlang/begin in))
-    (("func")  (dlang/func in))))
-
-(define (dlang/core-form? in) #f)
-  ;(define tok (buf-lookahead! in 1))
-  ;(cond (token-text tok)
-  ;  (("def" "set!" "if" "begin" "func") #t)
-  ;  (else #f)))
+  (define text (if (eof-object? tok) "" (token-text tok)))
+  (cond
+    ((string=? text "def")   (dlang/define in))
+    ((string=? text "set!")  (dlang/assign in))
+    ((string=? text "if")    (dlang/if in))
+    ((string=? text "begin") (dlang/begin in))
+    ((string=? text "func")  (dlang/func in))
+    (else (error "Expected a core form"))))
+
+(define (dlang/core-form? in)
+  (define tok (buf-lookahead! in 1))
+  (define text (if (eof-object? tok) "" (token-text tok)))
+  (or (string=? text "def")
+      (string=? text "set!")
+      (string=? text "if")
+      (string=? text "begin")
+      (string=? text "func")))
 
 (define (dlang/define in)
   (define node '())

diff --git a/tests/test_parser.scm b/tests/test_parser.scm
index e85a8e39f73d3353b485bef03dc5294ec2ee68b3..a2ef1f609c8adbd877d448149cd8f66eb10db718 100644 (file)
--- a/tests/test_parser.scm
+++ b/tests/test_parser.scm
@@ -15,6 +15,57 @@
 
 ; dlang/core-form
 ;------------------------------------------------------------------------------
+(def-test "dlang/define should parse a variable definition"
+  (call-with-input-string "def foo 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/core-form lxr))
+      (syntree=? result
+        (syntree 'define ""
+          (list
+            (syntree 'id "foo" '())
+            (syntree 'number "1.0" '())))))))
+
+(def-test "dlang/core-form should parse a variable assignment"
+  (call-with-input-string "set! foo 1.0;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/core-form lxr))
+      (syntree=? result
+        (syntree 'assign ""
+          (list
+            (syntree 'id "foo" '())
+            (syntree 'number "1.0" '())))))))
+
+(def-test "dlang/core-form should parse an if statement"
+  (call-with-input-string "if cond result1;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/core-form lxr))
+      (syntree=? result
+        (syntree 'if ""
+          (list
+            (syntree 'id "cond" '())
+            (syntree 'id "result1" '())))))))
+
+(def-test "dlang/core-form should parse a begin block"
+  (call-with-input-string "begin;"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/core-form lxr))
+      (syntree=? result
+        (syntree 'begin "" '())))))
+
+(def-test "dlang/core-form should parse a func"
+  (call-with-input-string "func();"
+    (lambda (input)
+      (define lxr (make-lexer input))
+      (define result (dlang/core-form lxr))
+      (syntree=? result
+        (syntree 'func ""
+          (list
+            (syntree 'args "" '())
+            (syntree 'block "" '())))))))
 
 ; dlang/define
 ;------------------------------------------------------------------------------
@@ -31,7 +82,7 @@
 
 ; dlang/assign
 ;------------------------------------------------------------------------------
-(def-test "dlang/assign should parse a variable definition"
+(def-test "dlang/assign should parse a variable assignment"
   (call-with-input-string "set! foo 1.0;"
     (lambda (input)
       (define lxr (make-lexer input))