Ticket #165: ticket-165.diff

File ticket-165.diff, 3.7 KB (added by Mark Evenson, 13 years ago)

  • src/org/armedbear/lisp/format.lisp 

    # 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  
    10731073     (after (nthcdr (1+ posn) directives)))
    10741074      (values
    10751075       (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)
    10771079                                                                        ,(if colonp
    10781080                                                                             (if atsignp
    10791081                                                                                 :upcase
    … …  
    25782580                             (let* ((posn (position close directives))
    25792581                                    (before (subseq directives 0 posn))
    25802582                                    (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)))))
    25892594                               (setf args (interpret-directive-list stream before orig-args args))
    25902595                               after))))
    25912596

  • test/lisp/abcl/bugs.lisp 

    diff -r 096ed241b4f9 test/lisp/abcl/bugs.lisp
    a b  
    8282                       (string (read-from-string "#:UPPER")))
    8383          (readtable-case *readtable*) original-case)
    8484    (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)")