GOOPS cosmetics

[bpt/guile.git] / test-suite / tests / elisp-reader.test

diff --git a/test-suite/tests/elisp-reader.test b/test-suite/tests/elisp-reader.test
index 365f578..cf7c15c 100644 (file)
--- a/test-suite/tests/elisp-reader.test
+++ b/test-suite/tests/elisp-reader.test
@@ -19,22 +19,20 @@
 
 (define-module (test-elisp-reader)
   :use-module (test-suite lib)
-  :use-module (language elisp lexer))
+  :use-module (language elisp lexer)
+  :use-module (language elisp parser))
 
 
 ; ==============================================================================
 ; Test the lexer.
 
-; This is of course somewhat redundant with the full parser checks, but probably
-; can't hurt and is useful in developing the lexer itself.
-
 (define (get-string-lexer str)
   (call-with-input-string str get-lexer))
 
 (define (lex-all lexer)
   (let iterate ((result '()))
     (let ((token (lexer)))
-      (if (eq? token '*eoi*)
+      (if (eq? (car token) 'eof)
         (reverse result)
         (iterate (cons token result))))))
 
@@ -45,15 +43,16 @@
 
   (let ((lexer (get-string-lexer "")))
     (pass-if "end-of-input"
-      (and (eq? (lexer) '*eoi*)
-           (eq? (lexer) '*eoi*)
-           (eq? (lexer) '*eoi*))))
+      (and (eq? (car (lexer)) 'eof)
+           (eq? (car (lexer)) 'eof)
+           (eq? (car (lexer)) 'eof))))
 
   (pass-if "single character tokens"
-    (equal? (lex-string "()[]'`, . ")
+    (equal? (lex-string "()[]'`,,@ . ")
       '((paren-open . #f) (paren-close . #f)
         (square-open . #f) (square-close . #f)
-        (quote . #f) (backquote . #f) (unquote . #f) (dot . #f))))
+        (quote . #f) (backquote . #f)
+        (unquote . #f) (unquote-splicing . #f) (dot . #f))))
 
   (pass-if "whitespace and comments"
     (equal? (lex-string "   (\n\t) ; this is a comment\n.   ; until eof")
@@ -117,10 +116,70 @@ test\"ab\"\\ abcd
               ,(- (char->integer #\X) (char->integer #\@))
               ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32))))
 
-  (let* ((lex1-string "((1 2) [2 [3]] 5)")
+  (pass-if "circular markers"
+    (equal? (lex-string "#0342= #1#")
+            '((circular-def . 342) (circular-ref . 1))))
+
+  (let* ((lex1-string "#1='((1 2) [2 [3]] 5)")
          (lexer (call-with-input-string (string-append lex1-string " 1 2")
                                         get-lexer/1)))
     (pass-if "lexer/1"
       (and (equal? (lex-all lexer) (lex-string lex1-string))
-           (eq? (lexer) '*eoi*)
-           (eq? (lexer) '*eoi*)))))
+           (eq? (car (lexer)) 'eof)
+           (eq? (car (lexer)) 'eof)))))
+
+
+; ==============================================================================
+; Test the parser.
+
+(define (parse-str str)
+  (call-with-input-string str read-elisp))
+
+(with-test-prefix "Parser"
+
+  (pass-if "only next expression"
+    (equal? (parse-str "1 2 3") 1))
+
+  (pass-if "source properties"
+    (let* ((list1 (parse-str "\n\n   (\n(7)  (42))"))
+           (list2 (car list1))
+           (list3 (cadr list1)))
+      (and (= (source-property list1 'line) 3)
+           (= (source-property list1 'column) 4)
+           (= (source-property list2 'line) 4)
+           (= (source-property list2 'column) 1)
+           (= (source-property list3 'line) 4)
+           (= (source-property list3 'column) 6))))
+
+  (pass-if "constants"
+    (and (equal? (parse-str "-12") -12)
+         (equal? (parse-str ".123") 0.123)
+         (equal? (parse-str "foobar") 'foobar)
+         (equal? (parse-str "\"abc\"") "abc")
+         (equal? (parse-str "?A") 65)
+         (equal? (parse-str "?\\C-@") 0)))
+
+  (pass-if "quotation"
+    (and (equal? (parse-str "'(1 2 3 '4)")
+                 '(quote (1 2 3 (quote 4))))
+         (equal? (parse-str "`(1 2 ,3 ,@a)")
+                 '(#{`}# (1 2 (#{,}# 3) (#{,@}# a))))))
+
+  (pass-if "lists"
+    (equal? (parse-str "(1 2 (3) () 4 (. 5) (1 2 . (3 4)) (1 . 2) . 42)")
+            '(1 2 (3) () 4 5 (1 2 3 4) (1 . 2) . 42)))
+
+  (pass-if "vectors"
+    (equal? (parse-str "[1 2 [] (3 4) \"abc\" d]")
+            #(1 2 #() (3 4) "abc" d)))
+
+  (pass-if "circular structures"
+    (and (equal? (parse-str "(#1=a #2=b #1# (#1=c #1# #2#) #1#)")
+                 '(a b a (c c b) c))
+         (let ((eqpair (parse-str "(#1=\"foobar\" . #1#)")))
+           (eq? (car eqpair) (cdr eqpair)))
+         (let ((circlst (parse-str "#1=(42 #1# #1=5 #1#)")))
+           (and (eq? circlst (cadr circlst))
+                (equal? (cddr circlst) '(5 5))))
+         (let ((circvec (parse-str "#1=[a #1# b]")))
+           (eq? circvec (vector-ref circvec 1))))))