From bd79fc27933e0f7b1dd2276e33c47c2ce30c3d08 Mon Sep 17 00:00:00 2001 From: Raymond Toy <toy.raymond@gmail.com> Date: Thu, 16 Dec 2021 18:56:43 +0000 Subject: [PATCH] Fix #121: fill-pointer-misc off by one for charpos --- src/code/stream.lisp | 5 ++++- src/general-info/release-21e.md | 1 + tests/issues.lisp | 14 ++++++++++++++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index f59f9cb7d..487e50a8f 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1928,7 +1928,10 @@ output to Output-stream" (let ((found (position #\newline string :test #'char= :end end :from-end t))) (if found - (- end (the fixnum found)) + ;; END points to where the next character goes, not the + ;; last character. FOUND is where the newline is. + ;; Subtract 1 to adjust for the difference. + (- end (the fixnum found) 1) current))))) (:element-type 'base-char))) diff --git a/src/general-info/release-21e.md b/src/general-info/release-21e.md index 6cbb28040..d43cf91eb 100644 --- a/src/general-info/release-21e.md +++ b/src/general-info/release-21e.md @@ -48,6 +48,7 @@ public domain. * ~~#108~~ Update ASDF * ~~#112~~ CLX can't connect to X server via inet sockets * ~~#113~~ REQUIRE on contribs can pull in the wrong things vai ASDF. + * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: diff --git a/tests/issues.lisp b/tests/issues.lisp index d3c47767e..67b0a700d 100644 --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -556,3 +556,17 @@ (assert-equalp 3.0380154777955097d205 (expt 1.7976931348623157d308 0.6666))) + +(define-test issue.121 + (:tag :issues) + ;; Output should only have one newline character in it. Previously, + ;; we printed two. + (assert-equalp + (concatenate 'string "xxx" (string #\Newline)) + (let ((a (make-array 0 :element-type 'character :fill-pointer 0 + :adjustable t))) + (with-output-to-string (s a) + (format s "xxx") + (terpri s) + (fresh-line s)) + a))) -- GitLab