Commit 5198e134 authored by mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

(partially) address ticket #165.

sbcl-buildhost gets much further, and the ANSI tests show no
additional failures, but still something is not quite right here.

N.B.  The test still doesn't succeed.
parent 543b1a40
......@@ -1073,7 +1073,9 @@
(after (nthcdr (1+ posn) directives)))
(values
(expand-bind-defaults () params
`(let ((stream (sys::make-case-frob-stream stream
`(let ((stream (sys::make-case-frob-stream (if (typep stream 'xp::xp-structure)
(xp::base-stream stream)
stream)
,(if colonp
(if atsignp
:upcase
......@@ -2578,14 +2580,17 @@
(let* ((posn (position close directives))
(before (subseq directives 0 posn))
(after (nthcdr (1+ posn) directives))
(stream (sys::make-case-frob-stream stream
(if colonp
(if atsignp
:upcase
:capitalize)
(if atsignp
:capitalize-first
:downcase)))))
(stream (sys::make-case-frob-stream
(if (typep stream 'xp::xp-structure)
(xp::base-stream stream)
stream)
(if colonp
(if atsignp
:upcase
:capitalize)
(if atsignp
:capitalize-first
:downcase)))))
(setf args (interpret-directive-list stream before orig-args args))
after))))
......
......@@ -82,4 +82,13 @@ Subject: [armedbear-devel] Bug in translate-logical-pathname.
(string (read-from-string "#:UPPER")))
(readtable-case *readtable*) original-case)
(values-list result))
"LOWER" "upper" "LOWER" "upper")
\ No newline at end of file
"LOWER" "upper" "LOWER" "upper")
;;; http://trac.common-lisp.net/armedbear/ticket/165
(deftest bugs.pprint.1
(let ((result (make-array '(0) :element-type 'base-char :fill-pointer t)))
(with-output-to-string (s result)
(pprint-logical-block (s nil :per-line-prefix "---")
(format s "~(~A~)" '(1 2 3 4))))
result)
"---(1 2 3 4)")
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment