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) 22 :use-module (language elisp lexer) 23 :use-module (language elisp parser)) 24 25 26; ============================================================================== 27; Test the lexer. 28 29(define (get-string-lexer str) 30 (call-with-input-string str get-lexer)) 31 32(define (lex-all lexer) 33 (let iterate ((result '())) 34 (let ((token (lexer))) 35 (if (eq? (car token) 'eof) 36 (reverse result) 37 (iterate (cons token result)))))) 38 39(define (lex-string str) 40 (lex-all (get-string-lexer str))) 41 42(with-test-prefix "Lexer" 43 44 (let ((lexer (get-string-lexer ""))) 45 (pass-if "end-of-input" 46 (and (eq? (car (lexer)) 'eof) 47 (eq? (car (lexer)) 'eof) 48 (eq? (car (lexer)) 'eof)))) 49 50 (pass-if "single character tokens" 51 (equal? (lex-string "()[]'`,,@ . ") 52 '((paren-open . #f) (paren-close . #f) 53 (square-open . #f) (square-close . #f) 54 (quote . #f) (backquote . #f) 55 (unquote . #f) (unquote-splicing . #f) (dot . #f)))) 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) 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 94test\\ 95\\\"ab\\\"\\\\ ab\\ cd 96\\418\\0415\\u0041\\U0000000A\\Xab\\x0000000000000004fG.\" ") 97 '((string . "foo\nbar 98test\"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 #\@)) 117 ,(+ (expt 2 22) (expt 2 23) (expt 2 24) 32)))) 118 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)") 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)) 128 (eq? (car (lexer)) 'eof) 129 (eq? (car (lexer)) 'eof))))) 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 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 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)") 166 '(#{`}# (1 2 (#{,}# 3) (#{,@}# a)))))) 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]") 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)))))) 186