From 3b447b3714d401c65adbc2c5839df73b7d300988 Mon Sep 17 00:00:00 2001
From: Joe Marshall <jmarshall@alum.mit.edu>
Date: Sat, 5 Sep 2009 10:32:04 -0700
Subject: [PATCH] Call SUBSTRING if SET-STRING-MAXIMUM-LENGTH! doesn't work. 
 (Jrm's port can't resize strings.)

---
 src/runtime/input.scm    |  6 +++++-
 src/runtime/pgsql.scm    | 11 +++++++----
 src/runtime/stringio.scm | 26 ++++++++++++++++----------
 3 files changed, 28 insertions(+), 15 deletions(-)

diff --git a/src/runtime/input.scm b/src/runtime/input.scm
index 18bb21669..cee7108d6 100644
--- a/src/runtime/input.scm
+++ b/src/runtime/input.scm
@@ -103,7 +103,11 @@ USA.
 
 (define-integrable (accum->string a)
   (set-string-maximum-length! (car a) (cdr a))
-  (car a))
+  ;; jrm's port cannot resize strings, so if the
+  ;; resize didn't work, just take the substring.
+  (if (fix:= (string-maximum-length (car a)) (cdr a))
+      (car a)
+      (substring (car a) 0 (cdr a))))
 
 (define-integrable (accum-count a)
   (cdr a))
diff --git a/src/runtime/pgsql.scm b/src/runtime/pgsql.scm
index f45c91a40..03b72625a 100644
--- a/src/runtime/pgsql.scm
+++ b/src/runtime/pgsql.scm
@@ -298,9 +298,12 @@ USA.
 
 (define (escape-pgsql-string string)
   (guarantee-pgsql-available)
-  (let ((escaped (make-string (fix:* 2 (string-length string)))))
-    (set-string-maximum-length! escaped (pq-escape-string string escaped))
-    escaped))
+  (let* ((escaped (make-string (fix:* 2 (string-length string))))
+	 (length  (pq-escape-string string escaped)))
+    (set-string-maximum-length! escaped length)
+    (if (fix:= (string-maximum-length escaped) length)
+	escaped
+	(substring escaped 0 length))))
 
 (define (encode-pgsql-bytea bytes)
   (guarantee-pgsql-available)
@@ -378,4 +381,4 @@ USA.
   (pq-get-is-null? (result->handle result) row column))
 
 (define (pgsql-cmd-tuples result)
-  (string->number (pq-cmd-tuples (result->handle result))))
\ No newline at end of file
+  (string->number (pq-cmd-tuples (result->handle result))))
diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm
index 3c7da9c9e..3c821c8a7 100644
--- a/src/runtime/stringio.scm
+++ b/src/runtime/stringio.scm
@@ -422,11 +422,14 @@ USA.
     (string-head (ostate-buffer os) (ostate-index os))))
 
 (define (narrow-out/extract-output! port)
-  (let ((os (port/state port)))
-    (let ((string (ostate-buffer os)))
-      (set-string-maximum-length! string (ostate-index os))
-      (reset-buffer! os)
-      string)))
+  (let* ((os (port/state port))
+	 (string (ostate-buffer os))
+	 (length (ostate-index os)))
+    (set-string-maximum-length! string length)
+    (reset-buffer! os)
+    (if (fix:= (string-maximum-length string) length)
+	string
+	(substring string 0 length))))
 
 (define (make-wide-output-type)
   (make-string-out-type wide-out/write-char
@@ -603,12 +606,15 @@ USA.
 
 (define (octets-out/extract-output! port)
   (output-port/flush-output port)
-  (let ((os (output-octets-port/os port)))
-    (let ((octets (ostate-buffer os)))
-      (set-string-maximum-length! octets (ostate-index os))
+  (let* ((os (output-octets-port/os port))
+	 (octets (ostate-buffer os))
+	 (length (ostate-index os)))
+      (set-string-maximum-length! octets length)
       (set-ostate-buffer! os (make-vector-8b 16))
       (set-ostate-index! os 0)
-      octets)))
+      (if (fix:= (string-maximum-length octets) length)
+	  octets
+	  (substring octets 0 length))))
 
 (define (octets-out/position port)
   (output-port/flush-output port)
@@ -636,4 +642,4 @@ USA.
   (set! wide-output-type (make-wide-output-type))
   (set! octets-output-type (make-octets-output-type))
   (set! output-octets-port/os (generic-i/o-port-accessor 0))
-  unspecific)
\ No newline at end of file
+  unspecific)
-- 
2.25.1