(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."
(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)