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