Re: [Sbcl-commits] master: Fix file-position on copmosite streams

Stas Boukarev <[email protected]> wrote:

> It always used to return something, I'm not going to change that.
> It was just returning the wrong thing for buffered streams.
> Evidently, nobody cares about it, so the status quo should remain.

I care, but I try not to propose incompatible changes till I see
somebody else float them. You incompatibly changed the methods for
two-way and echo streams, AFAICT because the ancient CMUCL methods gave
an arbitrary result. So I thought it a reasonable moment to raise the
observation that the ancient CMUCL method for concatenated streams, if
superficially less arbitrary, gives probably-non-conforming results no
matter how hard it must work to get a position from the first component.

But I won't belabor this any further.

Regards,
Richard


> On Wed, Aug 5, 2026 at 9:55 PM Richard M Kreuter <[email protected]> wrote:
> >
> > Hi Stas,
> >
> > IMO there are few reasons why FILE-POSITION should either do nothing (or
> > in the 2-arg case, perhaps error) on concatenated streams, too:
> >
> > 1) For unary FILE-POSITION, simply returning the position from the first
> >    component is not conforming, because the succession of those
> >    positions will not always increase monotonically as the client takes
> >    input from the concatenated stream, e.g.,
> >
> >    ;; FILE-POSITION is not explicitly required to work on any type of
> >    ;; stream, so consider these string streams as stand-ins for streams
> >    ;; on which FILE-POSITION works.
> >    (with-input-from-string (s1 "ab")
> >      (with-input-from-string (s2 "xy")
> >        (with-open-stream (cs (make-concatenated-stream s1 s2))
> >          (loop for p = (file-position cs)
> >                collect p
> >                unless (read-char cs nil)
> >                do (loop-finish)))))
> >    => (0 1 2 1 2)
> >
> >    It'd be possible for FILE-POSITION to transform the first component's
> >    position to produce a monotonically increasing result, but I don't
> >    think it's worthwhile, because any numeric result will be of little
> >    use with binary FILE-POSITION.
> >
> > 2) For binary FILE-POSITION, if a file position is to supposed be usable
> >    for going backwards in a stream, it's unclear how that could work on
> >    a concatenated stream that has already discarded an input
> >    component. For the previous example, after reading #\x, there's no
> >    way to reposition the concatenated stream back to re-read #\a or #\b,
> >    and after reaching EOF, there's no way to re-read anything.
> >
> > 3) Forwarding binary FILE-POSITION to the current input component also
> >    gives concatenated streams unusual, probably non-conforming,
> >    semantics when trying to reposition ahead in a stream. For example,
> >
> >    (with-input-from-string (s1 "ab")
> >      (with-input-from-string (s2 "xy")
> >        (with-open-stream (cs (make-concatenated-stream s1 s2))
> >          (when (file-position cs :end)
> >            (read-char cs nil)))))
> >    => #\x
> >
> >    I can't think of a reason to try to try reading after positioning to
> >    EOF, but the glossary entry for "file position designator" says :END
> >    means the position following the last element of the stream, which
> >    isn't happening there.
> >
> > That is, given how ANSI describes concatenated streams, it's not clear
> > how a conforming and useful FILE-POSITION could be implemented.
> >
> > And FWIW, none of the versions of ABCL, CCL, Clisp, ECL, or Allegro I
> > have around behave exactly as SBCL does for both the two code fragments
> > above. So users who somehow need an operator with the semantics of
> > SBCL's current FILE-POSITION on concatenated streams must write it
> > themselves. (They can conformingly, I think.)
> >
> > So ISTM the unary form should just be a no-op. The binary form is
> > allowed to be a no-op or, I think, to signal an error (stipulating that
> > any file position designator is "inappropriate" for a concatenated
> > stream); IDK which is better, though I note that it errors on CCL, so I
> > guess portable code must be prepared for that, too.
> >
> > Regards,
> > Richard
> >
> > stassats via Sbcl-commits writes:
> > > 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 :appe
> > > nd :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 :appe
> > > nd :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 :appe
> > > nd :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
> > >
> > >
> > > _______________________________________________
> > > Sbcl-commits mailing list
> > > [email protected]
> > > https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-devel