master: Fix file-position on copmosite streams

stassats via Sbcl-commits <[email protected]> Mon, 03 Aug 2026 21:12:37 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  bf87e9ab2c426d2231c2bcc14f77ce35c112d20e (commit)
      from  8ee5b24141f3e37a3cd56e9917d0027cd4695e2e (commit)

- Log -----------------------------------------------------------------
commit bf87e9ab2c426d2231c2bcc14f77ce35c112d20e
Author: Stas Boukarev <[email protected]>
Date:   Mon Aug 3 23:51:48 2026 +0300

    Fix file-position on copmosite streams
    
    concatenated-stream wasn't processing buffered input correctly.
    two-way-stream and echo-stream should just return NIL, as
    file-position can't apply to both streams.
---
 contrib/sb-simple-streams/simple-stream-tests.lisp |  6 ++----
 src/code/stream.lisp                               |  6 ++++++
 src/code/target-stream.lisp                        |  3 +++
 tests/input-manifest.lisp-expr                     |  6 ++++++
 tests/stream.pure.lisp                             | 16 ++++++++++++++++
 xperfecthash63.lisp-expr                           |  6 ++++++
 6 files changed, 39 insertions(+), 4 deletions(-)

diff --git a/contrib/sb-simple-streams/simple-stream-tests.lisp b/contrib/sb-simple-streams/simple-stream-tests.lisp
index 577071b35..7d152dee5 100644
--- a/contrib/sb-simple-streams/simple-stream-tests.lisp
+++ b/contrib/sb-simple-streams/simple-stream-tests.lisp
@@ -779,8 +779,7 @@ Nothing to see here, move along.")
 (deftest two-way-stream-16
     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (synonym)
-      (eql (file-position (make-two-way-stream synonym synonym))
-           (file-position synonym)))
+      (null (file-position (make-two-way-stream synonym synonym))))
   T)
 
 ;; SYNONYM-STREAM tests repeated for ECHO-STREAM, where applicable
@@ -850,8 +849,7 @@ Nothing to see here, move along.")
 (deftest echo-stream-16
     ;; FILE-POSITION (via STREAM-MISC-DISPATCH)
     (with-sc-test-stream (*synonym*)
-      (eql (file-position (make-echo-stream *synonym* *synonym*))
-           (file-position *synonym*)))
+      (null (file-position (make-echo-stream *synonym* *synonym*))))
   T)
 
 ;; SYNONYM-STREAM tests repeated for CONCATENATED-STREAM, where applicable
diff --git a/src/code/stream.lisp b/src/code/stream.lisp
index eef4680bc..de84b2445 100644
--- a/src/code/stream.lisp
+++ b/src/code/stream.lisp
@@ -1121,6 +1121,9 @@
            in-mode)))
       (:close
        (set-closed-flame stream))
+      ((:get-file-position :set-file-position)
+       ;; Unclear to which stream it should apply
+       nil)
       (t
        (or (if in-ansi-stream-p
                (call-ansi-stream-misc in operation arg1)
@@ -1217,6 +1220,9 @@
       (:unread (when left (unread-char arg1 current)))
       (:close
        (set-closed-flame stream))
+      (:get-file-position
+       (when current
+         (file-position current)))
       (t
        (when left
          (if (ansi-stream-p current)
diff --git a/src/code/target-stream.lisp b/src/code/target-stream.lisp
index 5b486e57b..7444cb450 100644
--- a/src/code/target-stream.lisp
+++ b/src/code/target-stream.lisp
@@ -220,6 +220,9 @@
            in-mode)))
       (:close
        (set-closed-flame stream))
+      ((:get-file-position :set-file-position)
+       ;; Unclear to which stream it should apply
+       nil)
       (t
        (or (if in-ansi-stream-p
                (call-ansi-stream-misc in operation arg1)
diff --git a/tests/input-manifest.lisp-expr b/tests/input-manifest.lisp-expr
index 57b97448d..408030b73 100644
--- a/tests/input-manifest.lisp-expr
+++ b/tests/input-manifest.lisp-expr
@@ -118,8 +118,14 @@
   "../contrib/sb-simd/test-suite/utilities.lisp"
   "../contrib/sb-simd/test-suite/test-suite.lisp"
   "../contrib/sb-simd/test-suite/test-arefs.lisp"
+  "../contrib/sb-simd/test-suite/test-arefs-arm64.lisp"
+  "../contrib/sb-simd/test-suite/test-arefs-x86-64.lisp"
   "../contrib/sb-simd/test-suite/test-simple-simd-functions.lisp"
+  "../contrib/sb-simd/test-suite/test-simple-simd-functions-arm64.lisp"
+  "../contrib/sb-simd/test-suite/test-simple-simd-functions-x86-64.lisp"
   "../contrib/sb-simd/test-suite/test-horizontal-functions.lisp"
+  "../contrib/sb-simd/test-suite/test-horizontal-functions-arm64.lisp"
+  "../contrib/sb-simd/test-suite/test-horizontal-functions-x86-64.lisp"
   "../contrib/sb-simd/test-suite/test-hairy-simd-functions.lisp"
   "../contrib/sb-simd/test-suite/test-packages.lisp")
  ("sb-simple-streams.impure.lisp" "contrib/sb-simple-streams.fasl" "contrib/sb-bsd-sockets.fasl"
diff --git a/tests/stream.pure.lisp b/tests/stream.pure.lisp
index 25d11c85b..83ac08f15 100644
--- a/tests/stream.pure.lisp
+++ b/tests/stream.pure.lisp
@@ -545,3 +545,19 @@
       (assert (= (read-sequence x s) 1))
       (assert (equalp d #(1 0 1)))
       (assert (equalp x #(0))))))
+
+(with-test (:name :composite-streams-file-position)
+  (with-open-file (str (or #+win32 "zero" "/dev/zero"))
+    (read-char str)
+    (assert (= (file-position (make-concatenated-stream str))
+               (file-position str))))
+  (with-open-file (str (or #+win32 "/dev/null" "/dev/zero") :if-exists :append :direction :output)
+    (write-char #\a str)
+    (assert (= (file-position (make-broadcast-stream str))
+               (file-position str))))
+  (with-open-file (i (or #+win32 "zero" "/dev/zero"))
+    (with-open-file (o (or #+win32 "/dev/null" "/dev/zero") :if-exists :append :direction :output)
+      (assert (null (file-position (make-echo-stream i o))))))
+  (with-open-file (i (or #+win32 "zero" "/dev/zero"))
+    (with-open-file (o (or #+win32 "/dev/null" "/dev/zero") :if-exists :append :direction :output)
+      (assert (null (file-position (make-two-way-stream i o)))))))
diff --git a/xperfecthash63.lisp-expr b/xperfecthash63.lisp-expr
index 98a6ed4bc..cc861bb33 100644
--- a/xperfecthash63.lisp-expr
+++ b/xperfecthash63.lisp-expr
@@ -1788,5 +1788,11 @@
 (#(A49305EF D0241AE7 E55E7F8C EE9A5410)
  "(SB-PCL::%CLASS SB-PCL::%PARAMETER SB-PCL::%VARIABLE-REBINDING SPECIAL)"
  "((& (>> val 8) 3))")
+(#(0 2 A 1A 1E)
+ "(5 15 1 13 0)"
+ "((let ((tab #a((4) (unsigned-byte 8) 2 0 0 7)))
+  (let ((b (& (>> val 1) #x3)))
+   (let ((a (>> (<< val 27) 30)))
+    (^ a (aref tab b))))))")
 )
 ;; EOF

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL