tests: Don't rely on `scm_call_2' being visible.

[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 51ba088..cf7c15c 100644 (file)
--- a/test-suite/tests/elisp-reader.test
+++ b/test-suite/tests/elisp-reader.test
@@ -19,39 +19,40 @@
 
 (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? (car token) 'eof)
+        (reverse result)
+        (iterate (cons token result))))))
+
 (define (lex-string str)
-  (let ((lexer (get-string-lexer str)))
-    (let iterate ((result '()))
-      (let ((token (lexer)))
-        (if (eq? token '*eoi*)
-          (reverse result)
-          (iterate (cons token result)))))))
+  (lex-all (get-string-lexer str)))
 
 (with-test-prefix "Lexer"
 
   (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")
@@ -84,4 +85,101 @@
     (equal? (lex-string "1500.0 15e2 15.e2 1.5e3 .15e4 -.345e-2")
             '((float . 1500.0) (float . 1500.0) (float . 1500.0)
               (float . 1500.0) (float . 1500.0)
-              (float . -0.00345)))))
+              (float . -0.00345))))
+
+  ; Check string lexing, this also checks basic character escape sequences
+  ; that are then (hopefully) also correct for character literals.
+  (pass-if "strings"
+    (equal? (lex-string "\"foo\\nbar
+test\\
+\\\"ab\\\"\\\\ ab\\ cd
+\\418\\0415\\u0041\\U0000000A\\Xab\\x0000000000000004fG.\"  ")
+            '((string . "foo\nbar
+test\"ab\"\\ abcd
+!8!5A\nXabOG."))))
+  (pass-if "ASCII control characters and meta in strings"
+    (equal? (lex-string "\"\\^?\\C-a\\C-A\\^z\\M-B\\M-\\^@\\M-\\C-a\"")
+            '((string . "\x7F\x01\x01\x1A\xC2\x80\x81"))))
+
+  ; Character literals, taking into account that some escape sequences were
+  ; already checked in the strings.
+  (pass-if "characters"
+    (equal? (lex-string "?A?\\z ? ?\\x21 ?\\^j ?\\\\?\\n?\\\n")
+            `((character . 65) (character . ,(char->integer #\z))
+              (character . 32) (character . ,(char->integer #\!))
+              (character . 10) (character . ,(char->integer #\\))
+              (character . 10) (character . 10))))
+  (pass-if "meta characters"
+    (equal? (map cdr (lex-string "?\\C-[?\\M-\\S-Z?\\^X?\\A-\\s-\\H-\\s"))
+            `(,(+ (expt 2 26) (char->integer #\[))
+              ,(+ (expt 2 27) (expt 2 25) (char->integer #\Z))
+              ,(- (char->integer #\X) (char->integer #\@))
+              ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32))))
+
+  (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? (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))))))