FORMAT-SYMBOL now uses WITH-STANDARD-IO-SYNTAX
authorNikodemus Siivola <nikodemus@random-state.net>
Sat, 26 Jan 2013 13:24:33 +0000 (15:24 +0200)
committerNikodemus Siivola <nikodemus@random-state.net>
Sat, 26 Jan 2013 13:24:33 +0000 (15:24 +0200)
symbols.lisp
tests.lisp

index e612afc..5733d3e 100644 (file)
@@ -21,12 +21,16 @@ Example:
 
 (declaim (inline format-symbol))
 (defun format-symbol (package control &rest arguments)
-  "Constructs a string by applying ARGUMENTS to string designator
-CONTROL as if by FORMAT, and then creates a symbol named by that
-string. If PACKAGE is NIL, returns an uninterned symbol, if package is
-T, returns a symbol interned in the current package, and otherwise
-returns a symbol interned in the package designated by PACKAGE."
-  (maybe-intern (apply #'format nil (string control) arguments) package))
+  "Constructs a string by applying ARGUMENTS to string designator CONTROL as
+if by FORMAT within WITH-STANDARD-IO-SYNTAX, and then creates a symbol named
+by that string.
+
+If PACKAGE is NIL, returns an uninterned symbol, if package is T, returns a
+symbol interned in the current package, and otherwise returns a symbol
+interned in the package designated by PACKAGE."
+  (maybe-intern (with-standard-io-syntax
+                  (apply #'format nil (string control) arguments))
+                package))
 
 (defun make-keyword (name)
   "Interns the string designated by NAME in the KEYWORD package."
index 61579d7..198104c 100644 (file)
     (starts-with-subseq "foo" "xfoop" :start2 1)
   t
   nil)
+
+(deftest format-symbol.print-case-bound
+    (let ((upper (intern "FOO-BAR"))
+          (lower (intern "foo-bar"))
+          (*print-escape* nil))
+      (values
+       (let ((*print-case* :downcase))
+         (and (eq upper (format-symbol t "~A" upper))
+               (eq lower (format-symbol t "~A" lower))))
+       (let ((*print-case* :upcase))
+         (and (eq upper (format-symbol t "~A" upper))
+               (eq lower (format-symbol t "~A" lower))))
+       (let ((*print-case* :capitalize))
+         (and (eq upper (format-symbol t "~A" upper))
+              (eq lower (format-symbol t "~A" lower))))))
+  t
+  t
+  t)