From 5053fbb98db84bebd6bb88fd8584bbee029320ed Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 1 Jul 2019 16:44:45 -0600
Subject: [PATCH] fix `open-string-input-port` on immutable strings

original commit: 48b0ace8b6fba756d8573698db4244472c64255f
---
 LOG                              |  4 ++-
 mats/io.ms                       | 59 ++++++++++++++++++--------------
 release_notes/release_notes.stex |  6 ++++
 s/cpnanopass.ss                  |  4 +--
 4 files changed, 44 insertions(+), 29 deletions(-)

diff --git a/LOG b/LOG
index 7655424816..75de93e72d 100644
--- a/LOG
+++ b/LOG
@@ -1371,4 +1371,6 @@
 - make test for relop-length more sensitive
     5_2.ms
 - added support for Microsoft Visual Studio 2019 on Windows
-    BUILDING, c/vs.bat, wininstall/locate-vcredist.bat
\ No newline at end of file
+    BUILDING, c/vs.bat, wininstall/locate-vcredist.bat
+- fixed open-string-input-port on immutable strings
+    cpnanopass.ss, io.ms, release_notes.stex
diff --git a/mats/io.ms b/mats/io.ms
index 5108e2e8c1..455636cdc7 100644
--- a/mats/io.ms
+++ b/mats/io.ms
@@ -105,17 +105,21 @@
                       (let ([c (get-u8 p)])
                         (cons (integer->char c) (f)))))))))
           "a b c d e")
-  (equal? (call-with-port
-           (open-file-input-port "testfile.ss")
-           (lambda (p)
-             (list->string
-              (let f ()
-                (let ([c (lookahead-u8 p)])
-                  (if (eof-object? c)
-                      '()
-                      (let ([c (get-u8 p)])
-                        (cons (integer->char c) (f)))))))))
-          "a b c d e")
+  (andmap (lambda (p)
+            (equal? (call-with-port
+                     p
+                     (lambda (p)
+                       (list->string
+                        (let f ()
+                          (let ([c (lookahead-u8 p)])
+                            (if (eof-object? c)
+                                '()
+                                (let ([c (get-u8 p)])
+                                  (cons (integer->char c) (f)))))))))
+                    "a b c d e"))
+          (list (open-file-input-port "testfile.ss")
+                (open-bytevector-input-port '#vu8(97 32 98 32 99 32 100 32 101))
+                (open-bytevector-input-port (bytevector->immutable-bytevector '#vu8(97 32 98 32 99 32 100 32 101)))))
   ; test various errors related to input ports
   (begin (set! ip (open-file-input-port "testfile.ss"))
          (and (port? ip) (input-port? ip)))
@@ -1292,21 +1296,24 @@
     (define $bop (let-values ([(op get) (open-bytevector-output-port)]) (set-binary-port-output-buffer! op #vu8(1 2 3 4 5)) op))
     #t)
   ; textual input
-  (equal?
-    (let ([ip (open-string-input-port "hello")])
-      (let ([buffer0 (textual-port-input-buffer ip)]
-            [index0 (textual-port-input-index ip)]
-            [size0 (textual-port-input-size ip)]
-            [count0 (textual-port-input-count ip)])
-        (read-char ip)
-        (list
-          (list buffer0 index0 size0 count0)
-          (list
-            (textual-port-input-buffer ip)
-            (textual-port-input-index ip)
-            (textual-port-input-size ip)
-            (textual-port-input-count ip)))))
-    '(("hello" 0 5 5) ("hello" 1 5 4)))
+  (andmap (lambda (str)
+            (equal?
+             (let ([ip (open-string-input-port str)])
+               (let ([buffer0 (textual-port-input-buffer ip)]
+                     [index0 (textual-port-input-index ip)]
+                     [size0 (textual-port-input-size ip)]
+                     [count0 (textual-port-input-count ip)])
+                 (read-char ip)
+                 (list
+                  (list buffer0 index0 size0 count0)
+                  (list
+                   (textual-port-input-buffer ip)
+                   (textual-port-input-index ip)
+                   (textual-port-input-size ip)
+                   (textual-port-input-count ip)))))
+             '(("hello" 0 5 5) ("hello" 1 5 4))))
+          (list "hello"
+                (string->immutable-string "hello")))
   (equal?
     (let ([ip (open-string-input-port "hello")])
       (let ([buffer0 (textual-port-input-buffer ip)]
diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex
index e77390f733..41fc623d3c 100644
--- a/release_notes/release_notes.stex
+++ b/release_notes/release_notes.stex
@@ -1695,6 +1695,12 @@ in fasl files does not generally make sense.
 %-----------------------------------------------------------------------------
 \section{Bug Fixes}\label{section:bugfixes}
 
+\subsection{String ports form immutable strings (9.5.4)}
+
+A bug that miscalculated the buffer size for
+\scheme{open-string-input-port} given an immutable string has been
+fixed.
+
 \subsection{Multiplying $-2^{30}$ with itself on 64-bit platforms (9.5.3)}
 
 A bug that produced the wrong sign when multiplying $-2^{30}$ with
diff --git a/s/cpnanopass.ss b/s/cpnanopass.ss
index 9004f2a851..f5d064e3ec 100644
--- a/s/cpnanopass.ss
+++ b/s/cpnanopass.ss
@@ -7681,9 +7681,9 @@
                         (build-dirty-store e-p ibuffer-disp e-b))
                    ,(bind #t ([e-length (if (eq? port-type 'textual)
                                             (translate
-                                              (%inline logxor
+                                              (%inline logand
                                                  ,(%mref ,e-b ,(constant string-type-disp))
-                                                 ,(%constant type-string))
+                                                 (immediate ,(fx- (expt 2 (constant string-length-offset)))))
                                               (constant string-length-offset)
                                               (constant string-char-offset))
                                             (%inline srl