Skip to content
Snippets Groups Projects
Commit 88cda677 authored by pfdietz's avatar pfdietz
Browse files

More extensive tests of a bug in sbcl (see print.symbol.prefix.6a)

parent 8f40459a
No related branches found
No related tags found
No related merge requests found
......@@ -588,29 +588,43 @@
(let ((pkg-name "PRINT-SYMBOL-TEST-PACKAGE"))
(when (find-package pkg-name)
(delete-package pkg-name))
(prog1
(let* ((pkg (make-package pkg-name))
(*package* (find-package "CL-TEST"))
(s (intern "ABC" pkg)))
(write-to-string s :case :upcase :readably nil :escape t))
;; (delete-package pkg)
)))
"PRINT-SYMBOL-TEST-PACKAGE::ABC")
(let ((pkg (make-package pkg-name)))
(multiple-value-prog1
(let* ((*package* (find-package "CL-TEST"))
(s (intern "ABC" pkg)))
(values
(write-to-string s :case :upcase :readably nil :escape t)
(let ((*package* pkg))
(write-to-string s :case :upcase :readably nil :escape t))
(let ((*package* pkg))
(write-to-string s :case :downcase :readably nil :escape t))
))
;; (delete-package pkg)
))))
"PRINT-SYMBOL-TEST-PACKAGE::ABC"
"ABC"
"abc")
(deftest print.symbol.prefix.6
(let ((pkg-name "PRINT-SYMBOL-TEST-PACKAGE"))
(when (find-package pkg-name)
(delete-package pkg-name))
(let ((pkg (make-package pkg-name)))
(prog1
(with-standard-io-syntax
(let* ((*package* pkg)
(s (intern "X" pkg)))
(write-to-string s :case :upcase :readably nil))
;; (delete-package pkg)
))))
"X")
(deftest print.symbol.prefix.6a
(with-standard-io-syntax
(let ((pkg-name "PRINT-SYMBOL-TEST-PACKAGE"))
(when (find-package pkg-name)
(delete-package pkg-name))
(prog1
(let* ((pkg (make-package pkg-name))
(*package* pkg)
(s (intern "ABC" pkg)))
(write-to-string s :case :upcase :readably nil :escape t))
;; (delete-package pkg)
)))
"ABC")
(let ((*package* (find-package "CL-TEST")))
(write-to-string 'x :case :upcase :readably nil)))
"X")
(deftest print.symbol.prefix.7
(with-standard-io-syntax
......@@ -682,10 +696,3 @@
)))
":X")
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment