* Chained stream implementation

packages/fcl-base/fpmake.pp

@@ -83,6 +83,7 @@ begin
           AddUnit('contnrs');
         end;
     T:=P.Targets.AddUnit('iostream.pp');
+    T:=P.Targets.AddUnit('chainstream.pp');
     T:=P.Targets.AddUnit('nullstream.pp');
       T.ResourceStrings:=true;
     T:=P.Targets.AddUnit('maskutils.pp');

packages/fcl-base/src/chainstream.pp

@@ -0,0 +1,315 @@
+{
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2022 by Michael Van Canneyt
+    member of the Free Pascal development team
+
+    Chained Streams implementation
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit chainstream;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+
+Type
+  TChainedStreamItem = record
+    Stream : TStream;
+    Size : Int64;
+  end;
+  TChainedStreamArray = Array of TChainedStreamItem;
+
+  { TChainedStream }
+
+  // Stream, backed by several other streams.
+  // A read operation will read bytes from the next stream in the chain if there is one, till the requested number of bytes is read.
+  // When writing, the current size of the streams is kept.
+  // i.e. the write operation overflows to the next stream, if any.
+
+  TChainedStream = class(TStream)
+    FStreams : TChainedStreamArray;
+    FPosition : Int64;
+    FCurrentStreamIdx : Integer;
+  private
+    FOwnsStreams: Boolean;
+    function GetStream(aIndex : Integer): TStream;
+    function GetStreamCount: Integer;
+  Protected
+    Function CurrentStream : TStream;
+    Function StreamSize : Int64;
+    Function NextStream : Boolean;
+    Function PrevStream : Boolean;
+    Function GetTotalSize : Int64;
+    function  GetSize: Int64; virtual;
+  Public
+    Constructor Create(aChain : Array of TStream; OwnsStreams : Boolean = False);
+    Destructor Destroy; override;
+    function Read(var Buffer; Count: Longint): Longint; override;
+    function Write(const Buffer; Count: Longint): Longint; override;
+    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
+    property StreamCount : Integer Read GetStreamCount;
+    property Streams[aIndex : Integer] : TStream Read GetStream;
+    Property OwnsStreams : Boolean Read FOwnsStreams Write FOwnsStreams;
+  end;
+
+implementation
+
+uses rtlconsts;
+
+{ TChainedStream }
+
+function TChainedStream.GetStreamCount: Integer;
+begin
+  Result:=Length(FStreams);
+end;
+
+function TChainedStream.GetStream(aIndex : Integer): TStream;
+begin
+  if (aIndex<0) or (aIndex>=Length(FStreams)) then
+    Raise EListError.CreateFmt(SListIndexError,[aIndex]);
+  Result:=FStreams[aIndex].Stream;
+end;
+
+function TChainedStream.CurrentStream: TStream;
+begin
+  if FCurrentStreamIdx<Length(FStreams) then
+    Result:=FStreams[FCurrentStreamIdx].Stream
+  else
+    Result:=Nil;
+end;
+
+function TChainedStream.StreamSize: Int64;
+begin
+  if FCurrentStreamIdx<Length(FStreams) then
+    begin
+    if FStreams[FCurrentStreamIdx].Size=-1 then
+      FStreams[FCurrentStreamIdx].Size:=FStreams[FCurrentStreamIdx].Stream.Size;
+    Result:=FStreams[FCurrentStreamIdx].Size;
+    end
+  else
+    Result:=0;
+end;
+
+function TChainedStream.NextStream: Boolean;
+begin
+  Inc(FCurrentStreamIdx);
+  Result:=FCurrentStreamIdx<Length(FStreams);
+end;
+
+function TChainedStream.PrevStream: Boolean;
+begin
+  Dec(FCurrentStreamIdx);
+  Result:=FCurrentStreamIdx>=0;
+end;
+
+function TChainedStream.GetTotalSize: Int64;
+
+var
+  aCurrent: Integer;
+
+begin
+  Result:=0;
+  aCurrent:=FCurrentStreamIdx;
+  try
+    FCurrentStreamIdx:=0;
+    While CurrentStream<>Nil do
+      begin
+      Result:=Result+StreamSize;
+      NextStream;
+      end;
+  finally
+    FCurrentStreamIdx:=aCurrent;
+  end;
+end;
+
+function TChainedStream.GetSize: Int64;
+begin
+  Result:=GetTotalSize;
+end;
+
+constructor TChainedStream.Create(aChain: array of TStream; OwnsStreams: Boolean);
+
+Var
+  I : Integer;
+
+begin
+  SetLength(FStreams,Length(aChain));
+  For I:=0 to Length(aChain)-1 do
+    begin
+    FStreams[i].Stream:=aChain[i];
+    FStreams[i].Size:=-1;
+    end;
+  FCurrentStreamIdx:=0;
+end;
+
+
+destructor TChainedStream.Destroy;
+
+Var
+  I : Integer;
+
+begin
+  If OwnsStreams then
+    For I:=0 to Length(FStreams) do
+      FreeAndNil(FStreams[i].Stream);
+  inherited Destroy;
+end;
+
+function TChainedStream.Read(var Buffer; Count: Longint): Longint;
+
+Var
+  aRead : Integer;
+  P : PByte;
+
+begin
+  Result:=0;
+  P:=@Buffer;
+  While (Count>0) and Assigned(CurrentStream) do
+    begin
+    aRead:=CurrentStream.Read(P^, Count);
+    Inc(P,aRead);
+    Dec(Count,aRead);
+    Inc(Result,aRead);
+    Inc(FPosition,aRead);
+    if Count>0 then
+      if NextStream then
+        CurrentStream.Position:=0
+      else
+        break;
+    end;
+end;
+
+function TChainedStream.Write(const Buffer; Count: Longint): Longint;
+
+Var
+  aBufAvail,aToWrite,aWritten : Integer;
+  P : PByte;
+  
+begin
+  Result:=0;
+  P:=@Buffer;
+  While (Count>0) and Assigned(CurrentStream) do
+    begin
+    aBufAvail:=StreamSize-CurrentStream.Position;
+    aToWrite:=Count;
+    if aToWrite>aBufAvail then
+      aToWrite:=aBufAvail;
+    if aToWrite>0 then
+      begin
+      aWritten:=CurrentStream.Write(P^, aToWrite);
+      Inc(P,aWritten);
+      Dec(Count,aWritten);
+      Inc(Result,aWritten);
+      Inc(FPosition,aWritten);
+      end;
+    if (Count>0) then
+      if NextStream then
+        CurrentStream.Position:=0
+      else
+        break;
+    end;
+end;
+
+function TChainedStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+
+Var
+  aOff : Int64;
+
+  Procedure MoveForward(aStartPos : Int64; aOrigin : TSeekOrigin);
+
+  begin
+    while (aOff>StreamSize-aStartPos) do
+      begin
+      Dec(aOff,StreamSize-aStartPos);
+      Inc(FPosition,StreamSize-aStartPos);
+      if not NextStream then
+        Break;
+      aStartPos:=0;
+      end;
+    if CurrentStream=Nil then
+      FCurrentStreamIdx:=Length(FStreams)-1;
+    if aOff>StreamSize then
+       aOff:=StreamSize;
+    inc(FPosition,aOff);
+    Result:=FPosition;
+    CurrentStream.Seek(aOff,aOrigin);
+  end;
+
+  Procedure MoveBackward(aStartSize : Int64; aOrigin : TSeekOrigin);
+
+  var
+    aSize : Int64;
+
+  begin
+    aOff:=Abs(aOff);
+    aSize:=aStartSize;
+    while (aOff>aSize) do
+      begin
+      Dec(aOff,aSize);
+      Dec(FPosition,aSize);
+      if not PrevStream then
+        Break
+      else
+        begin
+        aSize:=StreamSize;
+        CurrentStream.Seek(0,soEnd);
+        end;
+      end;
+    if CurrentStream=Nil then
+      FCurrentStreamIdx:=0;
+    if aOff>aSize then
+      aOff:=aSize;
+    Dec(FPosition,aOff);
+    Result:=FPosition;
+    if (aOrigin=soCurrent) and (aStartSize<>StreamSize) then
+      CurrentStream.Seek(-aOff,soCurrent)
+    else
+      CurrentStream.Seek(-aOff,soEnd);
+  end;
+
+begin
+  if (Offset=0) and (Origin=soCurrent) then
+    Exit(FPosition);
+  aOff:=Offset;
+  Case origin of
+    soBeginning :
+      begin
+      FCurrentStreamIdx:=0;
+      FPosition:=0;
+      if aOff<0 then
+        exit(FPosition);
+      MoveForward(0,soBeginning);
+      end;
+    soCurrent :
+      begin
+      if aOff>0 then
+        begin
+        MoveForward(Currentstream.Position,soCurrent);
+        end
+      else
+        begin
+        MoveBackward(CurrentStream.Position,soCurrent)
+        end;
+      end;
+    soEnd:
+      begin
+      FCurrentStreamIdx:=Length(FStreams)-1;
+      FPosition:=GetTotalSize;
+      MoveBackward(StreamSize,SoEnd)
+      end;
+  end;
+end;
+
+end.
+

packages/fcl-base/tests/fclbase-unittests.pp

@@ -4,7 +4,7 @@ program fclbase_unittests;
 
 uses
   Classes, consoletestrunner, tests_fptemplate, tchashlist,
-  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream, tccsvdocument;
+  testexprpars, tcmaskutils, tcinifile, tccsvreadwrite,tcbufferedfilestream, tccsvdocument, utcchainstream;
 
 var
   Application: TTestRunner;

packages/fcl-base/tests/utcchainstream.pp

@@ -0,0 +1,363 @@
+unit utcchainstream;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, chainstream;
+
+Type
+
+  { TTestChainStream }
+
+  TTestChainStream = Class (TTestCase)
+  private
+    FStreams : Array of TStream;
+    FStream: TChainedStream;
+    procedure ClearStreams;
+  Public
+    Function CreateStream(aOffset,aCount : Word) : TStream;
+    Procedure CreateChainedStream(Sizes : Array of Word; aOffset : Word = 0);
+    Procedure Setup; override;
+    Procedure TearDown; override;
+    Property Stream : TChainedStream Read FStream;
+  Published
+    Procedure TestEmpty;
+    Procedure TestCreateStream;
+    Procedure TestCreateStreams;
+    Procedure TestCreateStreams2;
+    Procedure TestOneStreamRead;
+    Procedure TestTwoStreamsRead;
+    Procedure TestTwoStreamsReadCrossBuffer;
+    Procedure TestTwoStreamsWrite;
+    Procedure TestTwoStreamsWriteCrossBuffer;
+    Procedure TestStreamsSeekFromEnd1;
+    Procedure TestStreamsSeekFromEnd2;
+    Procedure TestStreamsSeekFromBeginning1;
+    Procedure TestStreamsSeekFromBeginning2;
+    Procedure TestStreamsSeekFromCurrent1;
+    Procedure TestStreamsSeekFromCurrent2;
+  end;
+
+implementation
+
+{ TTestChainStream }
+
+function TTestChainStream.CreateStream(aOffset, aCount: Word): TStream;
+
+Var
+  I : integer;
+
+begin
+  Result:=TMemoryStream.Create;
+  For I:=0 to aCount-1 do
+    begin
+    Result.WriteBuffer(aOffset,SizeOf(Word));
+    Inc(aOffset);
+    end;
+  Result.Position:=0;
+end;
+
+procedure TTestChainStream.CreateChainedStream(Sizes: array of Word; aOffset : Word = 0);
+
+Var
+  I : integer;
+  aSize : Word;
+
+begin
+  ClearStreams;
+  SetLength(FStreams,Length(Sizes));
+  For I:=0 to Length(FStreams)-1 do
+    begin
+    aSize:=Sizes[i];
+    FStreams[i]:=CreateStream(aOffset,aSize);
+    Inc(aOffset,aSize);
+    end;
+  FStream:=TChainedStream.Create(FStreams,False);
+end;
+
+procedure TTestChainStream.Setup;
+begin
+
+  inherited Setup;
+end;
+
+procedure TTestChainStream.ClearStreams;
+
+var
+  I : Integer;
+
+begin
+  if Assigned(FStream) then
+    begin
+    if FStream.OwnsStreams then
+      FStreams:=[];
+    FStream.Free;
+    end;
+  For I:=0 to Length(FStreams)-1 do
+    FStreams[i].Free;
+end;
+
+procedure TTestChainStream.TearDown;
+begin
+  ClearStreams;
+  inherited TearDown;
+end;
+
+procedure TTestChainStream.TestEmpty;
+begin
+  AssertNull('No stream',FStream);
+  AssertEquals('No streams',0,Length(FStreams));
+end;
+
+procedure TTestChainStream.TestCreateStream;
+
+var
+  S : TStream;
+  I,W : Word;
+
+begin
+  S:=CreateStream(10,3);
+  try
+    AssertEquals('Stream position',0,S.Position);
+    AssertEquals('Stream size',6,S.Size);
+    For I:=10 to 12 do
+      begin
+      S.ReadBuffer(W,SizeOf(Word));
+      AssertEquals('Correct byte read',I,W);
+      end;
+  finally
+    S.Free;
+  end;
+end;
+
+procedure TTestChainStream.TestCreateStreams;
+
+begin
+  CreateChainedStream([10]);
+  AssertEquals('Correct stream count',1,Length(FStreams));
+  AssertEquals('Count',1,Stream.StreamCount);
+  AssertSame('Stream',FStreams[0],Stream.Streams[0]);
+  AssertEquals('Total size',20,Stream.Size);
+end;
+
+procedure TTestChainStream.TestCreateStreams2;
+begin
+  CreateChainedStream([10,10]);
+  AssertEquals('Correct stream count',2,Length(FStreams));
+  AssertEquals('Count',2,Stream.StreamCount);
+  AssertSame('Stream 0',FStreams[0],Stream.Streams[0]);
+  AssertSame('Stream 1',FStreams[1],Stream.Streams[1]);
+  AssertEquals('Total size',40,Stream.Size);
+end;
+
+procedure TTestChainStream.TestOneStreamRead;
+
+Var
+  I : Integer;
+  W : Word;
+
+begin
+  CreateChainedStream([10]);
+  For I:=0 to 9 do
+    begin
+    Stream.ReadBuffer(W,SizeOf(W));
+    AssertEquals('Correct bytes read',I,W)
+    end;
+end;
+
+procedure TTestChainStream.TestTwoStreamsRead;
+
+Var
+  I : Integer;
+  W : Word;
+
+begin
+  CreateChainedStream([10,10]);
+  For I:=0 to 19 do
+    begin
+    Stream.ReadBuffer(W,SizeOf(W));
+    AssertEquals('Correct bytes read',I,W)
+    end;
+end;
+
+procedure TTestChainStream.TestTwoStreamsReadCrossBuffer;
+Var
+  I : Integer;
+  W : Array of Word;
+
+begin
+  SetLength(W,20);
+  CreateChainedStream([10,10]);
+  Stream.ReadBuffer(W[0],Length(W)*SizeOf(Word));
+  For I:=0 to 19 do
+    begin
+    AssertEquals('Correct bytes read',I,W[i])
+    end;
+end;
+
+procedure TTestChainStream.TestTwoStreamsWrite;
+
+Var
+  I : Integer;
+  W : Word;
+
+begin
+  CreateChainedStream([10,10]);
+  For I:=100 to 119 do
+    begin
+    W:=I;
+    Stream.WriteBuffer(W,SizeOf(W));
+    end;
+  Stream.Position:=0;
+  For I:=100 to 119 do
+    begin
+    Stream.ReadBuffer(W,SizeOf(W));
+    AssertEquals('Correct bytes read',I,W)
+    end;
+end;
+
+procedure TTestChainStream.TestTwoStreamsWriteCrossBuffer;
+Var
+  I : Integer;
+  W : Array of Word;
+  WW : Word;
+
+begin
+  SetLength(W,20);
+  For I:=0 to 19 do
+    W[i]:=I;
+  CreateChainedStream([10,10]);
+  Stream.WriteBuffer(W[0],Length(W)*SizeOf(Word));
+  FStreams[0].Position:=0;
+  For I:=0 to 9 do
+    begin
+    FStreams[0].ReadBuffer(WW,SizeOf(WW));
+    AssertEquals('Correct bytes read',I,WW)
+    end;
+  FStreams[1].Position:=0;
+  For I:=10 to 19 do
+    begin
+    FStreams[1].ReadBuffer(WW,SizeOf(WW));
+    AssertEquals('Correct bytes read',I,WW)
+    end;
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromEnd1;
+
+Var
+  W : Word;
+
+begin
+  CreateChainedStream([10,10]);
+  AssertEquals('Seek',38,Stream.Seek(-2,soEnd));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read',19,W);
+  AssertEquals('Seek 2',20,Stream.Seek(-20,soEnd));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',10,W);
+  AssertEquals('Seek 3',18,Stream.Seek(-22,soEnd));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',9,W);
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromEnd2;
+
+Var
+  W : Word;
+
+begin
+  CreateChainedStream([10,10,10]);
+  AssertEquals('Seek',0,Stream.Seek(-60,soEnd));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read ',0,W);
+  AssertEquals('Seek',30,Stream.Seek(-30,soEnd));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read ',15,W);
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromBeginning1;
+
+Var
+  W : Word;
+
+begin
+  CreateChainedStream([10,10]);
+  AssertEquals('Seek',38,Stream.Seek(38,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read',19,W);
+  AssertEquals('Seek 2',20,Stream.Seek(20,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',10,W);
+  AssertEquals('Seek 3',18,Stream.Seek(18,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',9,W);
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromBeginning2;
+
+Var
+  W : Word;
+
+begin
+  CreateChainedStream([10,10,10]);
+  AssertEquals('Seek',0,Stream.Seek(0,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read ',0,W);
+  AssertEquals('Seek',30,Stream.Seek(30,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read ',15,W);
+  AssertEquals('Seek',50,Stream.Seek(50,soBeginning));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read ',25,W);
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromCurrent1;
+Var
+  W : Word;
+
+begin
+  CreateChainedStream([10,10]);
+  AssertEquals('Seek',4,Stream.Seek(4,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 1',2,W);
+  AssertEquals('Position after read 1',6,Stream.Position);
+  AssertEquals('Seek 2',26,Stream.Seek(20,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',13,W);
+  AssertEquals('Position after read 2',28,Stream.Position);
+  AssertEquals('Seek 3',32,Stream.Seek(4,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 3',16,W);
+  AssertEquals('Position after read 2',34,Stream.Position);
+end;
+
+procedure TTestChainStream.TestStreamsSeekFromCurrent2;
+Var
+  W : Word;
+  I : Integer;
+
+begin
+  CreateChainedStream([10,10]);
+  For I:=1 to 15 do
+    Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Position after reading data',30,Stream.Position);
+  AssertEquals('Seek',26,Stream.Seek(-4,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 1',13,W);
+  AssertEquals('Position after read 1',28,Stream.Position);
+  AssertEquals('Seek 2',8,Stream.Seek(-20,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 2',4,W);
+  AssertEquals('Position after read 2',10,Stream.Position);
+  AssertEquals('Seek 3',6,Stream.Seek(-4,soCurrent));
+  Stream.ReadBuffer(W,SizeOf(Word));
+  AssertEquals('Correct read 3',3,W);
+  AssertEquals('Position after read 2',8,Stream.Position);
+end;
+
+initialization
+  RegisterTest(TTestChainStream);
+end.
+