Updated parse-utils to use and validate posdata

diff --git a/source/parse-utils.scm b/source/parse-utils.scm
index dc2f2dafbb88abbcf67fd2f7401cfa8a6912e464..0d82c91654aa7964cb881cc0a605572f21bd52ee 100644 (file)
--- a/source/parse-utils.scm
+++ b/source/parse-utils.scm
@@ -12,9 +12,15 @@
 (define-record posdata name line column)
 (define posdata make-posdata)
 
+(define (posdata=? pd1 pd2)
+  (and (equal? (posdata-name pd1)   (posdata-name pd2))
+       (equal? (posdata-line pd1)   (posdata-line pd2))
+       (equal? (posdata-column pd1) (posdata-column pd2))))
+
 (define (token=? tok1 tok2)
   (and (equal? (token-type tok1) (token-type tok2))
-       (equal? (token-text tok1) (token-text tok2))))
+       (equal? (token-text tok1) (token-text tok2))
+       (posdata=? (token-pos tok1) (token-pos tok2))))
 
 (define (syntree=? tr1 tr2)
   (and (equal? (syntree-type tr1) (syntree-type tr2))
@@ -34,11 +40,13 @@
 
 (define (charport-read chprt)
   (define ch (read-char (charport-port chprt)))
-  (if (char=? ch #\newline)
-    (begin
+  (cond
+    ((eof-object? ch)) ; Do nothing for EOFs
+    ((char=? ch #\newline)
       (charport-line-set! chprt (+ 1 (charport-line chprt)))
       (charport-column-set! chprt 1))
-    (charport-column-set! chprt (+ 1 (charport-column chprt))))
+    (else
+      (charport-column-set! chprt (+ 1 (charport-column chprt)))))
   ch)
 
 (define (charport-posdata chprt)

diff --git a/tests/test_parse_utils.scm b/tests/test_parse_utils.scm
index 2ffb12eed78dbd7fd6dc72a04b5abc9108cded83..746ba1de0bd06d2a564923a4a04c6699e8a204f9 100644 (file)
--- a/tests/test_parse_utils.scm
+++ b/tests/test_parse_utils.scm
@@ -41,9 +41,34 @@
            (equal? 1 (charport-line port))
            (equal? 1 (charport-column port))))))
 
+; posdata=?
+;------------------------------------------------------------------------------
+(def-test "posdata=? should return true of the two objects are equal"
+  (posdata=?
+    (posdata "" 0 0)
+    (posdata "" 0 0)))
+
+(def-test "posdata=? should return false if name differs"
+  (not
+    (posdata=?
+      (posdata "foo" 0 0)
+      (posdata "bar" 0 0))))
+
+(def-test "posdata=? should return false if line differs"
+  (not
+    (posdata=?
+      (posdata "" 1 0)
+      (posdata "" 2 0))))
+
+(def-test "posdata=? should return false if column differs"
+  (not
+    (posdata=?
+      (posdata "" 0 1)
+      (posdata "" 0 2))))
+
 ; token=?
 ;------------------------------------------------------------------------------
-(def-test "token=? should return true if trees are equal"
+(def-test "token=? should return true if tokens are equal"
   (token=?
     (token 'foo "" (posdata "" 0 0))
     (token 'foo "" (posdata "" 0 0))))
@@ -60,6 +85,12 @@
       (token 'foo "a" (posdata "" 0 0))
       (token 'foo "b" (posdata "" 0 0)))))
 
+(def-test "token=? should return false if position data differs"
+  (not
+    (token=?
+      (token 'foo "a" (posdata "" 0 0))
+      (token 'foo "b" (posdata "" 1 0)))))
+
 ; syntree=?
 ;------------------------------------------------------------------------------
 (def-test "syntree=? should return true if trees are equal"
@@ -106,6 +137,14 @@
 
 ; charport-read
 ;------------------------------------------------------------------------------
+(def-test "charport-read should increment column when character is not newline"
+  (call-with-input-string ""
+    (lambda (input)
+      (define port (charport input))
+      (and (eof-object? (charport-read port))
+           (equal? 1 (charport-line port))
+           (equal? 1 (charport-column port))))))
+
 (def-test "charport-read should increment column when character is not newline"
   (call-with-input-string "a"
     (lambda (input)
@@ -199,7 +238,7 @@
       (define buffer (dlang/lexer input))
       (token=?
         (token-match buffer 'id)
-        (token 'id "a" (posdata "" 0 0))))))
+        (token 'id "a" (posdata "(string)" 1 2))))))
 
 (def-test "token-match should error when EOF received"
   (call-with-input-string ""
@@ -243,7 +282,7 @@
       (define buffer (dlang/lexer input))
       (token=?
         (keyword-match buffer "abc")
-        (token 'id "abc" (posdata "" 0 0))))))
+        (token 'id "abc" (posdata "(string)" 1 4))))))
 
 (def-test "keyword-match should error if next token not an id"
   (call-with-input-string "1.0"