Commit | Line | Data |
---|---|---|
25512a94 DK |
1 | ;;;; elisp-reader.test --- Test the reader used by the Elisp compiler. |
2 | ;;;; | |
3 | ;;;; Copyright (C) 2009 Free Software Foundation, Inc. | |
4 | ;;;; Daniel Kraft | |
5 | ;;;; | |
6 | ;;;; This library is free software; you can redistribute it and/or | |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
9 | ;;;; version 3 of the License, or (at your option) any later version. | |
10 | ;;;; | |
11 | ;;;; This library is distributed in the hope that it will be useful, | |
12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
14 | ;;;; Lesser General Public License for more details. | |
15 | ;;;; | |
16 | ;;;; You should have received a copy of the GNU Lesser General Public | |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
19 | ||
20 | (define-module (test-elisp-reader) | |
21 | :use-module (test-suite lib) | |
e840cc65 DK |
22 | :use-module (language elisp lexer) |
23 | :use-module (language elisp parser)) | |
25512a94 DK |
24 | |
25 | ||
26 | ; ============================================================================== | |
27 | ; Test the lexer. | |
28 | ||
25512a94 DK |
29 | (define (get-string-lexer str) |
30 | (call-with-input-string str get-lexer)) | |
31 | ||
ddb4364b DK |
32 | (define (lex-all lexer) |
33 | (let iterate ((result '())) | |
34 | (let ((token (lexer))) | |
e9de3529 | 35 | (if (eq? (car token) 'eof) |
ddb4364b DK |
36 | (reverse result) |
37 | (iterate (cons token result)))))) | |
38 | ||
25512a94 | 39 | (define (lex-string str) |
ddb4364b | 40 | (lex-all (get-string-lexer str))) |
25512a94 DK |
41 | |
42 | (with-test-prefix "Lexer" | |
43 | ||
44 | (let ((lexer (get-string-lexer ""))) | |
45 | (pass-if "end-of-input" | |
e9de3529 BT |
46 | (and (eq? (car (lexer)) 'eof) |
47 | (eq? (car (lexer)) 'eof) | |
48 | (eq? (car (lexer)) 'eof)))) | |
25512a94 DK |
49 | |
50 | (pass-if "single character tokens" | |
e840cc65 | 51 | (equal? (lex-string "()[]'`,,@ . ") |
25512a94 DK |
52 | '((paren-open . #f) (paren-close . #f) |
53 | (square-open . #f) (square-close . #f) | |
e840cc65 DK |
54 | (quote . #f) (backquote . #f) |
55 | (unquote . #f) (unquote-splicing . #f) (dot . #f)))) | |
25512a94 DK |
56 | |
57 | (pass-if "whitespace and comments" | |
58 | (equal? (lex-string " (\n\t) ; this is a comment\n. ; until eof") | |
59 | '((paren-open . #f) (paren-close . #f) (dot . #f)))) | |
60 | ||
61 | (pass-if "source properties" | |
62 | (let ((x (car (lex-string "\n\n \n . \n")))) | |
63 | (and (= (source-property x 'line) 4) | |
64 | (= (source-property x 'column) 3)))) | |
65 | ||
66 | (pass-if "symbols" | |
67 | (equal? (lex-string "foo FOO char-to-string 1+ \\+1 | |
68 | \\(*\\ 1\\ 2\\) | |
69 | +-*/_~!@$%^&=:<>{} | |
70 | abc(def)ghi .e5") | |
71 | `((symbol . foo) (symbol . FOO) (symbol . char-to-string) | |
72 | (symbol . 1+) (symbol . ,(string->symbol "+1")) | |
73 | (symbol . ,(string->symbol "(* 1 2)")) | |
74 | (symbol . +-*/_~!@$%^&=:<>{}) | |
75 | (symbol . abc) (paren-open . #f) (symbol . def) | |
76 | (paren-close . #f) (symbol . ghi) (symbol . .e5)))) | |
77 | ||
78 | ; Here we make use of the property that exact/inexact numbers are not equal? | |
79 | ; even when they have the same numeric value! | |
80 | (pass-if "integers" | |
81 | (equal? (lex-string "-1 1 1. +1 01234") | |
82 | '((integer . -1) (integer . 1) (integer . 1) (integer . 1) | |
83 | (integer . 1234)))) | |
84 | (pass-if "floats" | |
85 | (equal? (lex-string "1500.0 15e2 15.e2 1.5e3 .15e4 -.345e-2") | |
86 | '((float . 1500.0) (float . 1500.0) (float . 1500.0) | |
87 | (float . 1500.0) (float . 1500.0) | |
5b1ee3be DK |
88 | (float . -0.00345)))) |
89 | ||
90 | ; Check string lexing, this also checks basic character escape sequences | |
91 | ; that are then (hopefully) also correct for character literals. | |
92 | (pass-if "strings" | |
93 | (equal? (lex-string "\"foo\\nbar | |
94 | test\\ | |
95 | \\\"ab\\\"\\\\ ab\\ cd | |
96 | \\418\\0415\\u0041\\U0000000A\\Xab\\x0000000000000004fG.\" ") | |
97 | '((string . "foo\nbar | |
98 | test\"ab\"\\ abcd | |
99 | !8!5A\nXabOG.")))) | |
100 | (pass-if "ASCII control characters and meta in strings" | |
101 | (equal? (lex-string "\"\\^?\\C-a\\C-A\\^z\\M-B\\M-\\^@\\M-\\C-a\"") | |
102 | '((string . "\x7F\x01\x01\x1A\xC2\x80\x81")))) | |
103 | ||
104 | ; Character literals, taking into account that some escape sequences were | |
105 | ; already checked in the strings. | |
106 | (pass-if "characters" | |
107 | (equal? (lex-string "?A?\\z ? ?\\x21 ?\\^j ?\\\\?\\n?\\\n") | |
108 | `((character . 65) (character . ,(char->integer #\z)) | |
109 | (character . 32) (character . ,(char->integer #\!)) | |
110 | (character . 10) (character . ,(char->integer #\\)) | |
111 | (character . 10) (character . 10)))) | |
112 | (pass-if "meta characters" | |
113 | (equal? (map cdr (lex-string "?\\C-[?\\M-\\S-Z?\\^X?\\A-\\s-\\H-\\s")) | |
114 | `(,(+ (expt 2 26) (char->integer #\[)) | |
115 | ,(+ (expt 2 27) (expt 2 25) (char->integer #\Z)) | |
116 | ,(- (char->integer #\X) (char->integer #\@)) | |
ddb4364b DK |
117 | ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32)))) |
118 | ||
9a9f1231 DK |
119 | (pass-if "circular markers" |
120 | (equal? (lex-string "#0342= #1#") | |
121 | '((circular-def . 342) (circular-ref . 1)))) | |
122 | ||
123 | (let* ((lex1-string "#1='((1 2) [2 [3]] 5)") | |
ddb4364b DK |
124 | (lexer (call-with-input-string (string-append lex1-string " 1 2") |
125 | get-lexer/1))) | |
126 | (pass-if "lexer/1" | |
127 | (and (equal? (lex-all lexer) (lex-string lex1-string)) | |
e9de3529 BT |
128 | (eq? (car (lexer)) 'eof) |
129 | (eq? (car (lexer)) 'eof))))) | |
e840cc65 DK |
130 | |
131 | ||
132 | ; ============================================================================== | |
133 | ; Test the parser. | |
134 | ||
135 | (define (parse-str str) | |
136 | (call-with-input-string str read-elisp)) | |
137 | ||
138 | (with-test-prefix "Parser" | |
139 | ||
140 | (pass-if "only next expression" | |
141 | (equal? (parse-str "1 2 3") 1)) | |
142 | ||
9e90010f DK |
143 | (pass-if "source properties" |
144 | (let* ((list1 (parse-str "\n\n (\n(7) (42))")) | |
145 | (list2 (car list1)) | |
146 | (list3 (cadr list1))) | |
147 | (and (= (source-property list1 'line) 3) | |
148 | (= (source-property list1 'column) 4) | |
149 | (= (source-property list2 'line) 4) | |
150 | (= (source-property list2 'column) 1) | |
151 | (= (source-property list3 'line) 4) | |
152 | (= (source-property list3 'column) 6)))) | |
153 | ||
e840cc65 DK |
154 | (pass-if "constants" |
155 | (and (equal? (parse-str "-12") -12) | |
156 | (equal? (parse-str ".123") 0.123) | |
157 | (equal? (parse-str "foobar") 'foobar) | |
158 | (equal? (parse-str "\"abc\"") "abc") | |
159 | (equal? (parse-str "?A") 65) | |
160 | (equal? (parse-str "?\\C-@") 0))) | |
161 | ||
162 | (pass-if "quotation" | |
163 | (and (equal? (parse-str "'(1 2 3 '4)") | |
164 | '(quote (1 2 3 (quote 4)))) | |
165 | (equal? (parse-str "`(1 2 ,3 ,@a)") | |
0dbfdeef | 166 | '(#{`}# (1 2 (#{,}# 3) (#{,@}# a)))))) |
e840cc65 DK |
167 | |
168 | (pass-if "lists" | |
169 | (equal? (parse-str "(1 2 (3) () 4 (. 5) (1 2 . (3 4)) (1 . 2) . 42)") | |
170 | '(1 2 (3) () 4 5 (1 2 3 4) (1 . 2) . 42))) | |
171 | ||
172 | (pass-if "vectors" | |
173 | (equal? (parse-str "[1 2 [] (3 4) \"abc\" d]") | |
9a9f1231 DK |
174 | #(1 2 #() (3 4) "abc" d))) |
175 | ||
176 | (pass-if "circular structures" | |
177 | (and (equal? (parse-str "(#1=a #2=b #1# (#1=c #1# #2#) #1#)") | |
178 | '(a b a (c c b) c)) | |
179 | (let ((eqpair (parse-str "(#1=\"foobar\" . #1#)"))) | |
180 | (eq? (car eqpair) (cdr eqpair))) | |
181 | (let ((circlst (parse-str "#1=(42 #1# #1=5 #1#)"))) | |
182 | (and (eq? circlst (cadr circlst)) | |
183 | (equal? (cddr circlst) '(5 5)))) | |
184 | (let ((circvec (parse-str "#1=[a #1# b]"))) | |
185 | (eq? circvec (vector-ref circvec 1)))))) |