better symbol printing

diff --git a/src/print.lisp b/src/print.lisp
index 565d554..1718b82 100644 (file)
--- a/src/print.lisp
+++ b/src/print.lisp
@@ -70,7 +70,6 @@
       (null ch))))
 
 (defun special-escape (s package)
-  (return-from special-escape s)
   (if (or (potential-number s)
           (special-symbol-name s :uppercase (not (eq package (find-package "JS")))))
       (let ((result "|"))

diff --git a/src/read.lisp b/src/read.lisp
index a282a67..ca76ed6 100644 (file)
--- a/src/read.lisp
+++ b/src/read.lisp
@@ -132,7 +132,10 @@
     (#\'
      (list 'function (ls-read-1 stream)))
     (#\( (list-to-vector (%read-list stream)))
-    (#\: (make-symbol (string-upcase (read-until stream #'terminalp))))
+    (#\: (make-symbol
+          (unescape
+           (string-upcase-noescaped
+            (read-escaped-until stream #'terminalp)))))
     (#\\
      (let ((cname
             (concat (string (%read-char stream))

diff --git a/tests/print.lisp b/tests/print.lisp
index 786d6d3..8d58c3c 100644 (file)
--- a/tests/print.lisp
+++ b/tests/print.lisp
@@ -1,3 +1,18 @@
-(dolist (s '(foo fo\o 1..2 \1 \-10 \.\.\. 1E \1E+2 1E+))
-  (test (let ((x (read-from-string (prin1-to-string s))))
-          (and (symbolp x) (equal (symbol-name x) (symbol-name s))))))
+(test (let ((x (read-from-string (prin1-to-string 'foo))))
+        (and (symbolp x) (equal (symbol-name x) "FOO"))))
+(test (let ((x (read-from-string (prin1-to-string 'fo\o))))
+        (and (symbolp x) (equal (symbol-name x) "FOo"))))
+(test (let ((x (read-from-string (prin1-to-string '1..2))))
+        (and (symbolp x) (equal (symbol-name x) "1..2"))))
+(test (let ((x (read-from-string (prin1-to-string '\1))))
+        (and (symbolp x) (equal (symbol-name x) "1"))))
+(test (let ((x (read-from-string (prin1-to-string '\-10))))
+        (and (symbolp x) (equal (symbol-name x) "-10"))))
+(test (let ((x (read-from-string (prin1-to-string '\.\.\.))))
+        (and (symbolp x) (equal (symbol-name x) "..."))))
+(test (let ((x (read-from-string (prin1-to-string '1E))))
+        (and (symbolp x) (equal (symbol-name x) "1E"))))
+(test (let ((x (read-from-string (prin1-to-string '\1E+2))))
+        (and (symbolp x) (equal (symbol-name x) "1E+2"))))
+(test (let ((x (read-from-string (prin1-to-string '1E+))))
+        (and (symbolp x) (equal (symbol-name x) "1E+"))))