# HG changeset patch
# Parent 096ed241b4f9e72700dd5196f38906466fc018c4
(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.
diff -r 096ed241b4f9 src/org/armedbear/lisp/format.lisp
a
|
b
|
|
1073 | 1073 | (after (nthcdr (1+ posn) directives))) |
1074 | 1074 | (values |
1075 | 1075 | (expand-bind-defaults () params |
1076 | | `(let ((stream (sys::make-case-frob-stream stream |
| 1076 | `(let ((stream (sys::make-case-frob-stream (if (typep stream 'xp::xp-structure) |
| 1077 | (xp::base-stream stream) |
| 1078 | stream) |
1077 | 1079 | ,(if colonp |
1078 | 1080 | (if atsignp |
1079 | 1081 | :upcase |
… |
… |
|
2578 | 2580 | (let* ((posn (position close directives)) |
2579 | 2581 | (before (subseq directives 0 posn)) |
2580 | 2582 | (after (nthcdr (1+ posn) directives)) |
2581 | | (stream (sys::make-case-frob-stream stream |
2582 | | (if colonp |
2583 | | (if atsignp |
2584 | | :upcase |
2585 | | :capitalize) |
2586 | | (if atsignp |
2587 | | :capitalize-first |
2588 | | :downcase))))) |
| 2583 | (stream (sys::make-case-frob-stream |
| 2584 | (if (typep stream 'xp::xp-structure) |
| 2585 | (xp::base-stream stream) |
| 2586 | stream) |
| 2587 | (if colonp |
| 2588 | (if atsignp |
| 2589 | :upcase |
| 2590 | :capitalize) |
| 2591 | (if atsignp |
| 2592 | :capitalize-first |
| 2593 | :downcase))))) |
2589 | 2594 | (setf args (interpret-directive-list stream before orig-args args)) |
2590 | 2595 | after)))) |
2591 | 2596 | |
diff -r 096ed241b4f9 test/lisp/abcl/bugs.lisp
a
|
b
|
|
82 | 82 | (string (read-from-string "#:UPPER"))) |
83 | 83 | (readtable-case *readtable*) original-case) |
84 | 84 | (values-list result)) |
85 | | "LOWER" "upper" "LOWER" "upper") |
86 | | No newline at end of file |
| 85 | "LOWER" "upper" "LOWER" "upper") |
| 86 | |
| 87 | ;;; http://trac.common-lisp.net/armedbear/ticket/165 |
| 88 | (deftest bugs.pprint.1 |
| 89 | (let (s) |
| 90 | (with-output-to-string (s) |
| 91 | (pprint-logical-block (s nil :per-line-prefix "---") |
| 92 | (format s "~(~A~)" '(1 2 3 4)))) |
| 93 | s) |
| 94 | "---(1 2 3 4)") |