diff options
Diffstat (limited to 'test/src/lread-tests.el')
| -rw-r--r-- | test/src/lread-tests.el | 242 |
1 files changed, 197 insertions, 45 deletions
diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index ac730b4f005..57143dd81e5 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -1,23 +1,23 @@ ;;; lread-tests.el --- tests for lread.c -*- lexical-binding: t; -*- -;; Copyright (C) 2016-2017 Free Software Foundation, Inc. +;; Copyright (C) 2016-2022 Free Software Foundation, Inc. ;; Author: Philipp Stephani <phst@google.com> ;; This file is part of GNU Emacs. -;; This program is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. -;; This program is distributed in the hope that it will be useful, +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -25,6 +25,9 @@ ;;; Code: +(require 'ert) +(require 'ert-x) + (ert-deftest lread-char-number () (should (equal (read "?\\N{U+A817}") #xA817))) @@ -112,59 +115,37 @@ (should-error (read "#24r") :type 'invalid-read-syntax) (should-error (read "#") :type 'invalid-read-syntax)) +(ert-deftest lread-char-modifiers () + (should (eq ?\C-\M-é (+ (- ?\M-a ?a) ?\C-é))) + (should (eq (- ?\C-ŗ ?ŗ) (- ?\C-é ?é)))) + (ert-deftest lread-record-1 () (should (equal '(#s(foo) #s(foo)) (read "(#1=#s(foo) #1#)")))) -(defmacro lread-tests--with-temp-file (file-name-var &rest body) - (declare (indent 1)) - (cl-check-type file-name-var symbol) - `(let ((,file-name-var (make-temp-file "emacs"))) - (unwind-protect - (progn ,@body) - (delete-file ,file-name-var)))) - (defun lread-tests--last-message () (with-current-buffer "*Messages*" (save-excursion (goto-char (point-max)) (skip-chars-backward "\n") - (buffer-substring (line-beginning-position) (point))))) + (buffer-substring (pos-bol) (point))))) (ert-deftest lread-tests--unescaped-char-literals () "Check that loading warns about unescaped character literals (Bug#20852)." - (lread-tests--with-temp-file file-name + (ert-with-temp-file file-name (write-region "?) ?( ?; ?\" ?[ ?]" nil file-name) (should (equal (load file-name nil :nomessage :nosuffix) t)) (should (equal (lread-tests--last-message) (concat (format-message "Loading `%s': " file-name) "unescaped character literals " - "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) - -(ert-deftest lread-tests--funny-quote-symbols () - "Check that 'smart quotes' or similar trigger errors in symbol names." - (dolist (quote-char - '(#x2018 ;; LEFT SINGLE QUOTATION MARK - #x2019 ;; RIGHT SINGLE QUOTATION MARK - #x201B ;; SINGLE HIGH-REVERSED-9 QUOTATION MARK - #x201C ;; LEFT DOUBLE QUOTATION MARK - #x201D ;; RIGHT DOUBLE QUOTATION MARK - #x201F ;; DOUBLE HIGH-REVERSED-9 QUOTATION MARK - #x301E ;; DOUBLE PRIME QUOTATION MARK - #xFF02 ;; FULLWIDTH QUOTATION MARK - #xFF07 ;; FULLWIDTH APOSTROPHE - )) - (let ((str (format "%cfoo" quote-char))) - (should-error (read str) :type 'invalid-read-syntax) - (should (eq (read (concat "\\" str)) (intern str)))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' detected, " + "`?\\\"', `?\\(', `?\\)', `?\\;', `?\\[', `?\\]' " + "expected!"))))) (ert-deftest lread-test-bug26837 () "Test for https://debbugs.gnu.org/26837 ." - (let ((load-path (cons - (file-name-as-directory - (expand-file-name "data" (getenv "EMACS_TEST_DIRECTORY"))) - load-path))) + (let ((load-path (cons (ert-resource-directory) load-path))) (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))) (load "somelib2" nil t) @@ -172,19 +153,190 @@ literals (Bug#20852)." (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))))) -(ert-deftest lread-tests--old-style-backquotes () - "Check that loading warns about old-style backquotes." - (lread-tests--with-temp-file file-name - (write-region "(` (a b))" nil file-name) - (should (equal (load file-name nil :nomessage :nosuffix) t)) - (should (equal (lread-tests--last-message) - (concat (format-message "Loading `%s': " file-name) - "old-style backquotes detected!"))))) - (ert-deftest lread-lread--substitute-object-in-subtree () (let ((x (cons 0 1))) (setcar x x) (lread--substitute-object-in-subtree x 1 t) (should (eq x (cdr x))))) +(ert-deftest lread-long-hex-integer () + (should (bignump (read "#xffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff")))) + +(ert-deftest lread-test-bug-31186 () + (with-temp-buffer + (insert ";; -*- -:*-") + (should-not + ;; This used to crash in lisp_file_lexically_bound_p before the + ;; bug was fixed. + (eval-buffer)))) + +(ert-deftest lread-invalid-bytecodes () + (should-error + (let ((load-force-doc-strings t)) (read "#[0 \"\"]")))) + +(ert-deftest lread-string-to-number-trailing-dot () + (dolist (n (list (* most-negative-fixnum most-negative-fixnum) + (1- most-negative-fixnum) most-negative-fixnum + (1+ most-negative-fixnum) -1 0 1 + (1- most-positive-fixnum) most-positive-fixnum + (1+ most-positive-fixnum) + (* most-positive-fixnum most-positive-fixnum))) + (should (= n (string-to-number (format "%d." n)))))) + +(ert-deftest lread-circular-hash () + (should-error (read "#s(hash-table data #0=(#0# . #0#))"))) + +(ert-deftest test-inhibit-interaction () + (let ((inhibit-interaction t)) + (should-error (read-char "foo: ")) + (should-error (read-event "foo: ")) + (should-error (read-char-exclusive "foo: ")))) + +(ert-deftest lread-float () + (should (equal (read "13") 13)) + (should (equal (read "+13") 13)) + (should (equal (read "-13") -13)) + (should (equal (read "13.") 13)) + (should (equal (read "+13.") 13)) + (should (equal (read "-13.") -13)) + (should (equal (read "13.25") 13.25)) + (should (equal (read "+13.25") 13.25)) + (should (equal (read "-13.25") -13.25)) + (should (equal (read ".25") 0.25)) + (should (equal (read "+.25") 0.25)) + (should (equal (read "-.25") -0.25)) + (should (equal (read "13e4") 130000.0)) + (should (equal (read "+13e4") 130000.0)) + (should (equal (read "-13e4") -130000.0)) + (should (equal (read "13e+4") 130000.0)) + (should (equal (read "+13e+4") 130000.0)) + (should (equal (read "-13e+4") -130000.0)) + (should (equal (read "625e-4") 0.0625)) + (should (equal (read "+625e-4") 0.0625)) + (should (equal (read "-625e-4") -0.0625)) + (should (equal (read "1.25e2") 125.0)) + (should (equal (read "+1.25e2") 125.0)) + (should (equal (read "-1.25e2") -125.0)) + (should (equal (read "1.25e+2") 125.0)) + (should (equal (read "+1.25e+2") 125.0)) + (should (equal (read "-1.25e+2") -125.0)) + (should (equal (read "1.25e-1") 0.125)) + (should (equal (read "+1.25e-1") 0.125)) + (should (equal (read "-1.25e-1") -0.125)) + (should (equal (read "4.e3") 4000.0)) + (should (equal (read "+4.e3") 4000.0)) + (should (equal (read "-4.e3") -4000.0)) + (should (equal (read "4.e+3") 4000.0)) + (should (equal (read "+4.e+3") 4000.0)) + (should (equal (read "-4.e+3") -4000.0)) + (should (equal (read "5.e-1") 0.5)) + (should (equal (read "+5.e-1") 0.5)) + (should (equal (read "-5.e-1") -0.5)) + (should (equal (read "0") 0)) + (should (equal (read "+0") 0)) + (should (equal (read "-0") 0)) + (should (equal (read "0.") 0)) + (should (equal (read "+0.") 0)) + (should (equal (read "-0.") 0)) + (should (equal (read "0.0") 0.0)) + (should (equal (read "+0.0") 0.0)) + (should (equal (read "-0.0") -0.0)) + (should (equal (read "0e5") 0.0)) + (should (equal (read "+0e5") 0.0)) + (should (equal (read "-0e5") -0.0)) + (should (equal (read "0e-5") 0.0)) + (should (equal (read "+0e-5") 0.0)) + (should (equal (read "-0e-5") -0.0)) + (should (equal (read ".0e-5") 0.0)) + (should (equal (read "+.0e-5") 0.0)) + (should (equal (read "-.0e-5") -0.0)) + (should (equal (read "0.0e-5") 0.0)) + (should (equal (read "+0.0e-5") 0.0)) + (should (equal (read "-0.0e-5") -0.0)) + (should (equal (read "0.e-5") 0.0)) + (should (equal (read "+0.e-5") 0.0)) + (should (equal (read "-0.e-5") -0.0)) + ) + +(defun lread-test-read-and-print (str) + (let* ((read-circle t) + (print-circle t) + (val (read-from-string str))) + (if (consp val) + (prin1-to-string (car val)) + (error "reading %S failed: %S" str val)))) + +(defconst lread-test-circle-cases + '("#1=(#1# . #1#)" + "#1=[#1# a #1#]" + "#1=(#2=[#1# #2#] . #1#)" + "#1=(#2=[#1# #2#] . #2#)" + "#1=[#2=(#1# . #2#)]" + "#1=(#2=[#3=(#1# . #2#) #4=(#3# . #4#)])" + )) + +(ert-deftest lread-circle () + (dolist (str lread-test-circle-cases) + (ert-info (str :prefix "input: ") + (should (equal (lread-test-read-and-print str) str)))) + (should-error (read-from-string "#1=#1#") :type 'invalid-read-syntax)) + +(ert-deftest lread-deeply-nested () + ;; Check that we can read a deeply nested data structure correctly. + (let ((levels 10000) + (prefix nil) + (suffix nil)) + (dotimes (_ levels) + (push "([#s(r " prefix) + (push ")])" suffix)) + (let ((str (concat (apply #'concat prefix) + "a" + (apply #'concat suffix)))) + (let* ((read-circle t) + (result (read-from-string str))) + (should (equal (cdr result) (length str))) + ;; Check the result. (We can't build a reference value and compare + ;; using `equal' because that function is currently depth-limited.) + (named-let check ((x (car result)) (level 0)) + (if (equal level levels) + (should (equal x 'a)) + (should (and (consp x) (null (cdr x)))) + (let ((x2 (car x))) + (should (and (vectorp x2) (equal (length x2) 1))) + (let ((x3 (aref x2 0))) + (should (and (recordp x3) (equal (length x3) 2) + (equal (aref x3 0) 'r))) + (check (aref x3 1) (1+ level)))))))))) + +(ert-deftest lread-misc () + ;; Regression tests for issues found and fixed in bug#55676: + ;; Non-breaking space after a dot makes it a dot token. + (should (equal (read-from-string "(a .\u00A0b)") + '((a . b) . 7))) + ;; #_ without symbol following is the interned empty symbol. + (should (equal (read-from-string "#_") + '(## . 2)))) + +(ert-deftest lread-escaped-lf () + ;; ?\LF should signal an error; \LF is ignored inside string literals. + (should-error (read-from-string "?\\\n x")) + (should (equal (read-from-string "\"a\\\nb\"") '("ab" . 6)))) + +(ert-deftest lread-force-load-doc-strings () + ;; Verify that lazy doc strings are loaded lazily by default, + ;; but eagerly with `force-load-doc-strings' set. + (let ((file (expand-file-name "lazydoc.el" (ert-resource-directory)))) + (fmakunbound 'lazydoc-fun) + (load file) + (let ((f (symbol-function 'lazydoc-fun))) + (should (byte-code-function-p f)) + (should (equal (aref f 4) (cons file 87)))) + + (fmakunbound 'lazydoc-fun) + (let ((load-force-doc-strings t)) + (load file) + (let ((f (symbol-function 'lazydoc-fun))) + (should (byte-code-function-p f)) + (should (equal (aref f 4) "My little\ndoc string\nhere")))))) + ;;; lread-tests.el ends here |