common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

Test custom %readtable-read a little more

Browse source
This commit is contained in:
Douglas Katzman 2026-01-14 11:10:40 -05:00
parent b6f186ac9b
commit 065b27df44
1 changed files with 56 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
tests/filecompile.impure.lisp
View file

@ -9,6 +9,62 @@
(scratch-file-name "fasl")))))
(assert (search expect err-string))))))
(defun read-forms (stream)
(let ((*readtable* (copy-readtable nil))
(*read-eval* nil)
(forms))
(setf (sb-impl::%readtable-read *readtable*)
(lambda (rt stream char)
(let ((start (file-position stream)))
(multiple-value-bind (resultp result)
;; wonky1 tries to use a "#[" reader macro
;; wonky4 tries to use read-time-eval
(ignore-errors (sb-impl::read-object? rt stream char))
(when (and (eql resultp 1) (consp result))
(push (list start (car result) (file-position stream)) forms))
(values resultp result)))))
(loop until (eq (read stream nil stream) stream))
(nreverse forms)))
(with-test (:name :test-character-macro-hook)
(with-open-file (s "data/wonky1.lisp")
(assert (equal '((94 DEFVAR 115)
(87 PROGN 118))
(read-forms s))))
(with-open-file (s "data/wonky2.lisp")
(assert (equal '((294 NO-SUCH-FUNCTION 311)
(278 DEFVAR 312)
(263 MACROLET 313))
(read-forms s))))
(with-open-file (s "data/wonky3.lisp")
(assert (equal '((283 IMAGPART 294)
(263 REALPART 295)
(400 REALPART 418)
(459 QUOTE 471)
(443 TYPEP 472)
(513 QUOTE 525)
(497 TYPEP 526)
(438 AND 527))
(read-forms s))))
(with-open-file (s "data/wonky4.lisp")
(assert (equal '((1 IN-PACKAGE 21)
(44 NAME 62)
(43 (NAME :READER NAME) 63)
(24 DEFCLASS 64)
(67 DEFVAR 84)
(98 X 100)
(104 1+ 109)
(87 DEFUN 110)
(113 WARN 127)
(165 NAME 176)
(190 Y 192)
(196 1- 201)
(179 DEFUN 202))
(read-forms s)))))
#-sb-thread (invoke-restart 'run-tests::skip-file)
(unlock-package "SB-INT")