* Add TTestBufferedFileStream

git-svn-id: trunk@42897 -

.gitattributes

@@ -3144,6 +3144,7 @@ packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
 packages/fcl-base/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.pp svneol=native#text/plain
+packages/fcl-base/tests/tcbufferedfilestream.pp svneol=native#text/plain
 packages/fcl-base/tests/tccsvreadwrite.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.pp svneol=native#text/plain
 packages/fcl-base/tests/tcinifile.pp svneol=native#text/plain

packages/fcl-base/src/bufstream.pp

@@ -27,8 +27,10 @@ Const
 
 Type
 
+{ ---------------------------------------------------------------------
+  TBufStream - simple read or write buffer, for sequential reading/writing
+  ---------------------------------------------------------------------}
 
-  { TBufStream }
   TBufStream = Class(TOwnerStream)
   Private
     FTotalPos : Int64;
@@ -70,12 +72,83 @@ Type
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   end;
 
+{ ---------------------------------------------------------------------
+  TBufferedFileStream -
+  Multiple pages buffer for random access reading/writing in file.
+  ---------------------------------------------------------------------}
+
+  TBufferedFileStream = class(TFileStream)
+  private
+    const
+      TSTREAMCACHEPAGE_SIZE_DEFAULT=4*1024;
+      TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT=8;
+    type
+      TStreamCacheEntry=record
+        IsDirty: Boolean;
+        LastTick: NativeUInt;
+        PageBegin: int64;
+        PageRealSize: integer;
+        Buffer: Pointer;
+      end;
+      PStreamCacheEntry=^TStreamCacheEntry;
+  private
+    FCachePages: array of PStreamCacheEntry;
+    FCacheLastUsedPage: integer;
+    FCacheStreamPosition: int64;
+    FCacheStreamSize: int64;
+    FOpCounter: NativeUInt;
+    FStreamCachePageSize: integer;
+    FStreamCachePageMaxCount: integer;
+    FEmergencyFlag: Boolean;
+    procedure ClearCache;
+    procedure WriteDirtyPage(const aPage: PStreamCacheEntry);
+    procedure WriteDirtyPage(const aIndex: integer);
+    procedure WriteDirtyPages;
+    procedure EmergencyWriteDirtyPages;
+    procedure FreePage(const aPage: PStreamCacheEntry; const aFreeBuffer: Boolean); inline;
+    function  LookForPositionInPages: Boolean;
+    function  ReadPageForPosition: Boolean;
+    function  ReadPageBeforeWrite: Boolean;
+    function  FreeOlderInUsePage(const aFreeBuffer: Boolean=false): PStreamCacheEntry;
+    function  GetOpCounter: NativeUInt; inline;
+    function  DoCacheRead(var Buffer; Count: Longint): Longint;
+    function  DoCacheWrite(const Buffer; Count: Longint): Longint;
+  protected
+    function  GetPosition: Int64; override;
+    procedure SetPosition(const Pos: Int64); override;
+    function  GetSize: Int64; override;
+    procedure SetSize64(const NewSize: Int64); override;
+    procedure SetSize(NewSize: Longint); override;overload;
+    procedure SetSize(const NewSize: Int64); override;overload;
+  public
+    // Warning using Mode=fmOpenWrite because the write buffer
+    // needs to read, as this class is a cache system not a dumb buffer.
+    constructor Create(const AFileName: string; Mode: Word);
+    constructor Create(const AFileName: string; Mode: Word; Rights: Cardinal);
+    destructor  Destroy; override;
+    function  Seek(Offset: Longint; Origin: Word): Longint; override; overload;
+    function  Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override; overload;
+    function  Read(var Buffer; Count: Longint): Longint; override;
+    function  Write(const Buffer; Count: Longint): Longint; override;
+    // Flush write-cache content to disk
+    procedure Flush;
+    // re-initialize the cache with aCacheBlockCount block
+    // of aCacheBlockSize bytes in each block.
+    procedure InitializeCache(const aCacheBlockSize: integer; const aCacheBlockCount: integer);
+  end;
+
+
 implementation
 
 Resourcestring
-  SErrCapacityTooSmall = 'Capacity is less than actual buffer size.';
+  SErrCapacityTooSmall    = 'Capacity is less than actual buffer size.';
   SErrCouldNotFLushBuffer = 'Could not flush buffer';
-  SErrInvalidSeek = 'Invalid buffer seek operation';
+  SErrInvalidSeek         = 'Invalid buffer seek operation';
+
+  SErrCacheUnexpectedPageDiscard ='CACHE: Unexpected behaviour. Discarded page.';
+  SErrCacheUnableToReadExpected = 'CACHE: Unable to read expected bytes (Open for write only ?). Expected: %d, effective read: %d';
+  SErrCacheUnableToWriteExpected ='CACHE: Unable to write expected bytes (Open for read only ?). Expected: %d, effective write: %d';
+  SErrCacheInternal = 'CACHE: Internal error.';
 
 { TBufStream }
 
@@ -257,4 +330,518 @@ begin
 end;
 
 
+
+{ ---------------------------------------------------------------------
+  TBufferedFileStream
+  ---------------------------------------------------------------------}
+
+procedure TBufferedFileStream.ClearCache;
+var
+  j: integer;
+  pStream: PStreamCacheEntry;
+begin
+  try
+    WriteDirtyPages;
+  finally
+    for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+      pStream:=FCachePages[j];
+      if Assigned(pStream) then begin
+        if Assigned(pStream^.Buffer) then Freemem(pStream^.Buffer);
+        Dispose(pStream);
+        FCachePages[j]:=nil;
+      end;
+    end;
+  end;
+end;
+
+procedure TBufferedFileStream.WriteDirtyPage(const aPage: PStreamCacheEntry);
+var
+  lEffectiveBytesWrite: integer;
+begin
+  inherited Seek(aPage^.PageBegin,soBeginning);
+  lEffectiveBytesWrite:=inherited Write(aPage^.Buffer^,aPage^.PageRealSize);
+  if lEffectiveBytesWrite<>aPage^.PageRealSize then begin
+    EmergencyWriteDirtyPages;
+    Raise EStreamError.CreateFmt(SErrCacheUnableToWriteExpected,[aPage^.PageRealSize,lEffectiveBytesWrite,IntToStr(aPage^.PageBegin)]);
+  end;
+  aPage^.IsDirty:=False;
+  aPage^.LastTick:=GetOpCounter;
+end;
+
+procedure TBufferedFileStream.WriteDirtyPage(const aIndex: integer);
+var
+  pCache: PStreamCacheEntry;
+begin
+  pCache:=FCachePages[aIndex];
+  if Assigned(pCache) then begin
+    WriteDirtyPage(pCache);
+  end;
+end;
+
+procedure TBufferedFileStream.WriteDirtyPages;
+var
+  j: integer;
+  pCache: PStreamCacheEntry;
+begin
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    pCache:=FCachePages[j];
+    if Assigned(pCache) then begin
+      if pCache^.IsDirty then begin
+        WriteDirtyPage(pCache);
+      end;
+    end;
+  end;
+end;
+
+procedure TBufferedFileStream.EmergencyWriteDirtyPages;
+var
+  j: integer;
+  pCache: PStreamCacheEntry;
+begin
+  // Are we already in a emergency write dirty pages ??
+  if FEmergencyFlag then exit;
+  FEmergencyFlag:=true;
+  // This procedure tries to save all dirty pages inconditional
+  // because a write fail happens, so everything in cache will
+  // be dumped to stream if possible, trying to save as much
+  // information as possible.
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    pCache:=FCachePages[j];
+    if Assigned(pCache) then begin
+      if pCache^.IsDirty then begin
+        try
+          WriteDirtyPage(pCache);
+        except on e: Exception do begin
+          // Do nothing, eat exception if happen.
+          // This way the cache still holds data to be
+          // written (that fails) and can be written later
+          // if write fail conditions change.
+          end;
+        end;
+      end;
+    end;
+  end;
+  FEmergencyFlag:=False;
+end;
+
+procedure TBufferedFileStream.FreePage(const aPage: PStreamCacheEntry;
+  const aFreeBuffer: Boolean);
+begin
+  aPage^.PageBegin:=0;
+  aPage^.PageRealSize:=0;
+  aPage^.LastTick:=0;
+  aPage^.IsDirty:=false;
+  if aFreeBuffer then begin
+    FreeMem(aPage^.Buffer);
+    aPage^.Buffer:=nil;
+  end;
+end;
+
+function TBufferedFileStream.LookForPositionInPages: Boolean;
+var
+  j: integer;
+  pCache: PStreamCacheEntry;
+begin
+  Result:=false;
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    pCache:=FCachePages[j];
+    if Assigned(pCache^.Buffer) then begin
+      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
+        FCacheLastUsedPage:=j;
+        Result:=true;
+        exit;
+      end;
+    end;
+  end;
+end;
+
+function TBufferedFileStream.ReadPageForPosition: Boolean;
+var
+  j: integer;
+  pCache: PStreamCacheEntry=nil;
+  lStreamPosition: int64;
+begin
+  // Find free page entry
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    if not Assigned(FCachePages[j]^.Buffer) then begin
+      pCache:=FCachePages[j];
+      FCacheLastUsedPage:=j;
+      break;
+    end;
+  end;
+  if not Assigned(pCache) then begin
+    // Free last used page
+    pCache:=FreeOlderInUsePage(false);
+  end;
+  if not Assigned(pCache^.Buffer) then begin
+    Getmem(pCache^.Buffer,FStreamCachePageSize);
+  end;
+  lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
+  inherited Seek(lStreamPosition,soBeginning);
+  pCache^.PageBegin:=lStreamPosition;
+  pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
+  if pCache^.PageRealSize=FStreamCachePageSize then begin
+    pCache^.LastTick:=GetOpCounter;
+    Result:=true;
+  end else begin
+    if FCacheStreamPosition<lStreamPosition+pCache^.PageRealSize then begin
+      pCache^.LastTick:=GetOpCounter;
+      Result:=true;
+    end else begin
+      Result:=false;
+    end;
+  end;
+end;
+
+function TBufferedFileStream.ReadPageBeforeWrite: Boolean;
+var
+  j: integer;
+  pCache: PStreamCacheEntry=nil;
+  lStreamPosition: int64;
+  lExpectedBytesToRead: integer;
+  lEffectiveRead: integer;
+begin
+  // Find free page entry
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    if not Assigned(FCachePages[j]^.Buffer) then begin
+      pCache:=FCachePages[j];
+      FCacheLastUsedPage:=j;
+      break;
+    end;
+  end;
+  if not Assigned(pCache) then begin
+    // Free last used page
+    pCache:=FreeOlderInUsePage(false);
+  end;
+  if not Assigned(pCache^.Buffer) then begin
+    Getmem(pCache^.Buffer,FStreamCachePageSize);
+  end;
+  lStreamPosition:=(FCacheStreamPosition div FStreamCachePageSize)*FStreamCachePageSize;
+  inherited Seek(lStreamPosition,soBeginning);
+  if (lStreamPosition+FStreamCachePageSize) > FCacheStreamSize then begin
+    lExpectedBytesToRead:=FCacheStreamSize-lStreamPosition;
+  end else begin
+    lExpectedBytesToRead:=FStreamCachePageSize;
+  end;
+  pCache^.PageBegin:=lStreamPosition;
+  pCache^.PageRealSize:=inherited Read(pCache^.Buffer^,FStreamCachePageSize);
+  if pCache^.PageRealSize<>lExpectedBytesToRead then begin
+    lEffectiveRead:=pCache^.PageRealSize;
+    pCache^.IsDirty:=false;
+    pCache^.LastTick:=0;
+    pCache^.PageBegin:=0;
+    pCache^.PageRealSize:=0;
+    Freemem(pCache^.Buffer);
+    pCache^.Buffer:=nil;
+    Raise EStreamError.CreateFmt(SErrCacheUnableToReadExpected,[lExpectedBytesToRead,lEffectiveRead]);
+  end;
+  pCache^.LastTick:=GetOpCounter;
+  Result:=true;
+end;
+
+function TBufferedFileStream.FreeOlderInUsePage(const aFreeBuffer: Boolean
+  ): PStreamCacheEntry;
+var
+  j: integer;
+  lOlderTick: int64=High(int64);
+  lOlderEntry: integer=-1;
+begin
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    Result:=FCachePages[j];
+    if Assigned(Result^.Buffer) then begin
+      if Result^.LastTick<lOlderTick then begin
+        lOlderTick:=Result^.LastTick;
+        lOlderEntry:=j;
+      end;
+    end;
+  end;
+  if lOlderEntry=-1 then begin
+    Raise Exception.Create(SErrCacheInternal);
+  end;
+  Result:=FCachePages[lOlderEntry];
+  FCacheLastUsedPage:=lOlderEntry;
+  if Result^.IsDirty then begin
+    WriteDirtyPage(Result);
+  end;
+  FreePage(Result,aFreeBuffer);
+end;
+
+function TBufferedFileStream.GetOpCounter: NativeUInt;
+begin
+  Result:=FOpCounter;
+  {$PUSH}
+  {$Q-}
+  inc(FOpCounter);
+  {$POP}
+end;
+
+function TBufferedFileStream.DoCacheRead(var Buffer; Count: Longint): Longint;
+var
+  pCache: PStreamCacheEntry;
+  lAvailableInThisPage: integer;
+  lPositionInPage: integer;
+  lNewBuffer: PBYTE;
+begin
+  pCache:=FCachePages[FCacheLastUsedPage];
+  if Assigned(pCache) then begin
+    // Check if FCacheStreamPosition is in range
+    if Assigned(pCache^.Buffer) then begin
+      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+pCache^.PageRealSize) then begin
+        // Position is in range, so read available data from this page up to count or page end
+        lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
+        lAvailableInThisPage:=pCache^.PageRealSize - lPositionInPage;
+        if lAvailableInThisPage>=Count then begin
+          move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,Count);
+          inc(FCacheStreamPosition,Count);
+          Result:=Count;
+          pCache^.LastTick:=GetOpCounter;
+          exit;
+        end else begin
+          move((PBYTE(pCache^.Buffer)+lPositionInPage)^,Buffer,lAvailableInThisPage);
+          inc(FCacheStreamPosition,lAvailableInThisPage);
+          if pCache^.PageRealSize=FStreamCachePageSize then begin
+            lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
+            Result:=lAvailableInThisPage+DoCacheRead(lNewBuffer^,Count-lAvailableInThisPage);
+          end else begin
+            // This cache page is not filled, so it is the last one
+            // in the file, nothing more to read...
+            pCache^.LastTick:=GetOpCounter;
+            Result:=lAvailableInThisPage;
+          end;
+          exit;
+        end;
+      end else begin
+        // The position is in other cache page or not in cache at all, so look for
+        // position in cached pages or allocate a new page.
+        if LookForPositionInPages then begin
+          Result:=DoCacheRead(Buffer,Count);
+          exit;
+        end else begin
+          if ReadPageForPosition then begin
+            Result:=DoCacheRead(Buffer,Count);
+          end else begin
+            Result:=0;
+          end;
+          exit;
+        end;
+      end;
+    end else begin
+      if ReadPageForPosition then begin
+        Result:=DoCacheRead(Buffer,Count);
+      end else begin
+        Result:=0;
+      end;
+      exit;
+    end;
+  end else begin
+    // The page has been discarded for some unknown reason
+    Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard);
+  end;
+end;
+
+function TBufferedFileStream.DoCacheWrite(const Buffer; Count: Longint): Longint;
+var
+  pCache: PStreamCacheEntry;
+  lAvailableInThisPage: integer;
+  lPositionInPage: integer;
+  lNewBuffer: PBYTE;
+begin
+  pCache:=FCachePages[FCacheLastUsedPage];
+  if Assigned(pCache) then begin
+    // Check if FCacheStreamPosition is in range
+    if Assigned(pCache^.Buffer) then begin
+      if (FCacheStreamPosition>=pCache^.PageBegin) and (FCacheStreamPosition<pCache^.PageBegin+FStreamCachePageSize) then begin
+        // Position is in range, so write data up to end of page
+        lPositionInPage:=(FCacheStreamPosition-pCache^.PageBegin);
+        lAvailableInThisPage:=FStreamCachePageSize - lPositionInPage;
+        if lAvailableInThisPage>=Count then begin
+          move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,Count);
+          if not pCache^.IsDirty then pCache^.IsDirty:=true;
+          inc(FCacheStreamPosition,Count);
+          // Update page size
+          if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+Count;
+          // Update file size
+          if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
+          Result:=Count;
+          pCache^.LastTick:=GetOpCounter;
+          exit;
+        end else begin
+          move(Buffer,(PBYTE(pCache^.Buffer)+lPositionInPage)^,lAvailableInThisPage);
+          if not pCache^.IsDirty then pCache^.IsDirty:=true;
+          inc(FCacheStreamPosition,lAvailableInThisPage);
+          // Update page size
+          if lPositionInPage+Count > pCache^.PageRealSize then pCache^.PageRealSize:=lPositionInPage+lAvailableInThisPage;
+          // Update file size
+          if FCacheStreamPosition>FCacheStreamSize then FCacheStreamSize:=FCacheStreamPosition;
+
+          Assert(pCache^.PageRealSize=FStreamCachePageSize,'This must not happend');
+          lNewBuffer:=PBYTE(@Buffer)+lAvailableInThisPage;
+          Result:=lAvailableInThisPage+DoCacheWrite(lNewBuffer^,Count-lAvailableInThisPage);
+          exit;
+        end;
+      end else begin
+        // The position is in other cache page or not in cache at all, so look for
+        // position in cached pages or allocate a new page.
+        if LookForPositionInPages then begin
+          Result:=DoCacheWrite(Buffer,Count);
+          exit;
+        end else begin
+          if ReadPageBeforeWrite then begin
+            Result:=DoCacheWrite(Buffer,Count);
+          end else begin
+            Result:=0;
+          end;
+          exit;
+        end;
+      end;
+    end else begin
+      if ReadPageBeforeWrite then begin
+        Result:=DoCacheWrite(Buffer,Count);
+      end else begin
+        Result:=0;
+      end;
+      exit;
+    end;
+  end else begin
+    // The page has been discarded for some unknown reason
+    Raise EStreamError.Create(SErrCacheUnexpectedPageDiscard);
+  end;
+end;
+
+function TBufferedFileStream.GetPosition: Int64;
+begin
+  Result:=FCacheStreamPosition;
+end;
+
+procedure TBufferedFileStream.SetPosition(const Pos: Int64);
+begin
+  if Pos<0 then begin
+    FCacheStreamPosition:=0;
+  end else begin
+    FCacheStreamPosition:=Pos;
+  end;
+end;
+
+function TBufferedFileStream.GetSize: Int64;
+begin
+  Result:=FCacheStreamSize;
+end;
+
+procedure TBufferedFileStream.SetSize64(const NewSize: Int64);
+var
+  j: integer;
+  pCache: PStreamCacheEntry;
+begin
+  WriteDirtyPages;
+  inherited SetSize64(NewSize);
+  FCacheStreamSize:=inherited Seek(0,soFromEnd);
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    pCache:=FCachePages[j];
+    if Assigned(pCache^.Buffer) and (pCache^.PageRealSize+pCache^.PageBegin>FCacheStreamSize) then begin
+      // This page is out of bounds the new file size
+      // so discard it.
+      FreePage(pCache,True);
+      break;
+    end;
+  end;
+end;
+
+procedure TBufferedFileStream.SetSize(NewSize: Longint);
+begin
+  SetSize64(NewSize);
+end;
+
+procedure TBufferedFileStream.SetSize(const NewSize: Int64);
+begin
+  SetSize64(NewSize);
+end;
+
+constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word);
+begin
+  // Initialize with 8 blocks of 4096 bytes
+  InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
+  inherited Create(AFileName,Mode);
+  FCacheStreamSize:=inherited Seek(int64(0),soEnd);
+end;
+
+constructor TBufferedFileStream.Create(const AFileName: string; Mode: Word;
+  Rights: Cardinal);
+begin
+  // Initialize with 8 blocks of 4096 bytes
+  InitializeCache(TSTREAMCACHEPAGE_SIZE_DEFAULT,TSTREAMCACHEPAGE_MAXCOUNT_DEFAULT);
+  inherited Create(AFileName,Mode,Rights);
+  FCacheStreamSize:=inherited Seek(int64(0),soEnd);
+end;
+
+function TBufferedFileStream.Read(var Buffer; Count: Longint): Longint;
+begin
+  Result:=DoCacheRead(Buffer,Count);
+end;
+
+function TBufferedFileStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  Result:=DoCacheWrite(Buffer,Count);
+end;
+
+procedure TBufferedFileStream.Flush;
+begin
+  WriteDirtyPages;
+end;
+
+function TBufferedFileStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+  Result:=Seek(int64(OffSet),TSeekOrigin(Origin));
+end;
+
+function TBufferedFileStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
+var
+  lNewOffset: int64;
+begin
+  Case Origin of
+    soEnd:
+      begin
+        lNewOffset:=FCacheStreamSize+Offset;
+      end;
+    soBeginning:
+      begin
+        lNewOffset:=0+Offset;
+      end;
+    soCurrent:
+      begin
+        lNewOffset:=FCacheStreamPosition+Offset;
+      end;
+  end;
+  if lNewOffset>0 then begin
+    FCacheStreamPosition:=lNewOffset;
+    Result:=lNewOffset;
+  end else begin
+    // This is compatible with FPC stream
+    // as it returns the negative value :-?
+    // but in fact does not move the read pointer.
+    Result:=-1;
+  end;
+end;
+
+procedure TBufferedFileStream.InitializeCache(const aCacheBlockSize: integer;
+  const aCacheBlockCount: integer);
+var
+  j: integer;
+begin
+  ClearCache;
+  FStreamCachePageSize:=aCacheBlockSize;
+  FStreamCachePageMaxCount:=aCacheBlockCount;
+  FCacheStreamSize:=inherited Seek(0,soEnd);
+  SetLength(FCachePages,FStreamCachePageMaxCount);
+  for j := 0 to Pred(FStreamCachePageMaxCount) do begin
+    FCachePages[j]:=New(PStreamCacheEntry);
+    FillByte(FCachePages[j]^,Sizeof(PStreamCacheEntry^),0);
+  end;
+end;
+
+destructor TBufferedFileStream.Destroy;
+begin
+  ClearCache;
+  inherited Destroy;
+end;
+
 end.

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

@@ -1,14 +1,15 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <General>
       <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
         <MainUnitHasCreateFormStatements Value="False"/>
         <MainUnitHasTitleStatement Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="fclbase-unittests"/>
       <UseAppBundle Value="False"/>
       <ResourceType Value="res"/>
@@ -16,28 +17,29 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="1">
       <Item1 Name="Default" Default="True"/>
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
       <local>
-        <FormatVersion Value="1"/>
         <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
       </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <CommandLineParams Value="--suite=TTestCSVReadWrite.TestInlineQuotedLine"/>
+          </local>
+        </Mode0>
+      </Modes>
     </RunParams>
-    <Units Count="6">
+    <Units Count="7">
       <Unit0>
         <Filename Value="fclbase-unittests.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="fclbase_unittests"/>
       </Unit0>
       <Unit1>
         <Filename Value="tchashlist.pp"/>
@@ -59,6 +61,10 @@
         <Filename Value="tccsvreadwrite.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit5>
+      <Unit6>
+        <Filename Value="tcbufferedfilestream.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit6>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

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

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

packages/fcl-base/tests/tcbufferedfilestream.pp

@@ -0,0 +1,393 @@
+unit tcbufferedfilestream;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, bufstream;
+
+type
+
+  { TTestBufferedFileStream }
+
+  TTestBufferedFileStream= class(TTestCase)
+  private
+  const
+    TEST_RANDOM_READS=10000;
+    TEST_SEQUENTIAL_READS=1000000;
+    TEST_FILENAME='testfile.bin';
+    TEST_WRITEC_FILE='testwritecache.bin';
+    TEST_WRITEF_FILE='testwritedirec.bin';
+  private
+    function CompareStreams(const aStream1: TStream; const aStream2: TStream): Boolean;
+  protected
+    procedure SetUp; override;
+    procedure TearDown; override;
+  published
+    procedure TestCacheRead;
+    procedure TestCacheWrite;
+    procedure TestCacheSeek;
+  end;
+
+implementation
+
+procedure TTestBufferedFileStream.TestCacheRead;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  b: array [0..10000-1] of char;
+  j,k: integer;
+  lBytesToRead: integer;
+  lEffectiveRead: integer;
+  {$IFDEF CHECK_AGAINST_FILE}
+  lEffectiveRead2: integer;
+  {$ENDIF}
+  lReadPosition: int64;
+  lCheckInitV: integer;
+  lTick: QWord;
+begin
+  b[0]:=#0; // Avoid initalization hint
+  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  try
+    RandSeed:=1;
+    Randomize;
+    lTick:=GetTickCount64;
+    for j := 0 to Pred(TEST_RANDOM_READS) do begin
+      lBytesToRead:=Random(10000);
+      lReadPosition:=Random(lBufferedStream.Size);
+      lBufferedStream.Position:=lReadPosition;
+
+      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
+
+      {$IFDEF CHECK_AGAINST_FILE}
+      // Now read without cache
+      lStream.Position:=lReadPosition;
+      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
+      if lEffectiveRead<>lEffectiveRead2 then begin
+        FAIL('Read length mismatch');
+      end;
+      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
+        FAIL('Compare buffer data error');
+      end;
+      F.Position:=0;
+      {$ELSE}
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
+          FAIL('Expected data error');
+        end;
+        inc(lCheckInitV);
+      end;
+      {$ENDIF}
+    end;
+    // Writeln('CACHE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
+
+    RandSeed:=1;
+    Randomize;
+
+    // Writeln('Same operation without cache');
+    lTick:=GetTickCount64;
+    for j := 0 to Pred(TEST_RANDOM_READS) do begin
+      lBytesToRead:=Random(10000);
+      lReadPosition:=Random(lBufferedStream.Size);
+
+      lStream.Position:=lReadPosition;
+      lEffectiveRead:=lStream.Read(b,lBytesToRead);
+
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
+          FAIL('Expected data error');
+        end;
+        inc(lCheckInitV);
+      end;
+    end;
+    // Writeln('FILE ',TEST_RANDOM_READS,' random reads in ',GetTickCount64-lTick,' ms.');
+
+    // Writeln('Check sequential read');
+
+    RandSeed:=1;
+    Randomize;
+    lTick:=GetTickCount64;
+    lBytesToRead:=1;
+    lReadPosition:=0;
+    lBufferedStream.Position:=lReadPosition;
+    lStream.Position:=lReadPosition;
+    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
+
+      lEffectiveRead:=lBufferedStream.Read(b,lBytesToRead);
+
+      {$IFDEF CHECK_AGAINST_FILE}
+      // Now read without cache
+      lEffectiveRead2:=lStream.Read(b2,lBytesToRead);
+      if lEffectiveRead<>lEffectiveRead2 then begin
+        FAIL('Read length mismatch');
+      end;
+      if not CompareMem(@b[0],@b2[0],lEffectiveRead) then begin
+        FAIL('Compare buffer data error');
+      end;
+      F.Position:=0;
+      {$ELSE}
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
+          FAIL('Expected data error');
+        end;
+        inc(lCheckInitV);
+      end;
+      {$ENDIF}
+      inc(lReadPosition,lBytesToRead);
+    end;
+    // Writeln('CACHE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
+
+    RandSeed:=1;
+    Randomize;
+    lTick:=GetTickCount64;
+    lBytesToRead:=1;
+    lReadPosition:=0;
+    lStream.Position:=lReadPosition;
+    for j := 0 to Pred(TEST_SEQUENTIAL_READS) do begin
+
+      lEffectiveRead:=lStream.Read(b,lBytesToRead);
+
+      lCheckInitV:=lReadPosition mod 10;
+      for k := 0 to Pred(lEffectiveRead) do begin
+        if b[k]<>char(ord('0')+lCheckInitV mod 10) then begin
+          FAIL('Expected data error');
+        end;
+        inc(lCheckInitV);
+      end;
+      inc(lReadPosition,lBytesToRead);
+    end;
+    // Writeln('FILE ',TEST_SEQUENTIAL_READS,' byte sequential reads in ',GetTickCount64-lTick,' ms.');
+
+    // Writeln('CACHE Trying read beyond limits');
+    lBufferedStream.Position:=lBufferedStream.Size-1;
+    lEffectiveRead:=lBufferedStream.Read(b,2);
+    if lEffectiveRead<>1 then begin
+      FAIL('Read beyond limits, returned bytes: '+inttostr(lEffectiveRead));
+    end else begin
+      // Writeln('CACHE OK, read beyond limits returns 0 bytes.');
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+end;
+
+procedure TTestBufferedFileStream.TestCacheWrite;
+const
+  EXPECTED_SIZE=10000000;
+  TEST_ROUNDS=100000;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  lVerifyStream1,lVerifyStream2: TFileStream;
+  b: array [0..10000-1] of char;
+  j: integer;
+  lBytesToWrite: integer;
+  lWritePosition: int64;
+begin
+  // Writeln('Testing write cache');
+  // All test should return the same random sequence
+  RandSeed:=1;
+  Randomize;
+  for j := 0 to Pred(10000) do begin
+    b[j]:='0';
+  end;
+  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmCreate);
+  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmCreate);
+  try
+    for j := 0 to Pred(EXPECTED_SIZE div Sizeof(b)) do begin
+      lBufferedStream.Write(b,sizeof(b));
+      lStream.Write(b,sizeof(b));
+    end;
+    for j := 0 to Pred(Sizeof(b)) do begin
+      b[j]:=char(ord('0')+j mod 10);
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+  lBufferedStream:=TBufferedFileStream.Create(TEST_WRITEC_FILE,fmOpenReadWrite);
+  lStream:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenWrite);
+  try
+    for j := 0 to Pred(TEST_ROUNDS) do begin
+      if lStream.Size<>lBufferedStream.Size then begin
+        FAIL('Mismatched lengths');
+      end;
+      lWritePosition:=Random(EXPECTED_SIZE);
+      lBytesToWrite:=Random(sizeof(b));
+      lBufferedStream.Position:=lWritePosition;
+      lStream.Position:=lWritePosition;
+      lBufferedStream.Write(b,lBytesToWrite);
+      lStream.Write(b,lBytesToWrite);
+      // if j mod 1273 = 0 then write(j,' / ',TEST_ROUNDS,#13);
+    end;
+    // Writeln(TEST_ROUNDS,' / ',TEST_ROUNDS);
+    if lStream.Size<>lBufferedStream.Size then begin
+      FAIL('Mismatched lengths');
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+
+  // Verify both generated files are identical.
+  lVerifyStream1:=TFileStream.Create(TEST_WRITEC_FILE,fmOpenRead or fmShareDenyWrite);
+  lVerifyStream2:=TFileStream.Create(TEST_WRITEF_FILE,fmOpenRead or fmShareDenyWrite);
+  try
+    if not CompareStreams(lVerifyStream1,lVerifyStream2) then begin
+      FAIL('Streams are different!!');
+    end else begin
+      // Writeln('Streams are identical. OK.');
+    end;
+  finally
+    lVerifyStream1.Free;
+    lVerifyStream2.Free;
+  end;
+end;
+
+procedure TTestBufferedFileStream.TestCacheSeek;
+var
+  lBufferedStream: TBufferedFileStream;
+  lStream: TFileStream;
+  bBuffered: array [0..10000] of BYTE;
+  bStream: array [0..10000] of BYTE;
+  bread : Integer;
+
+begin
+  bBuffered[0]:=0; // Avoid initalization hint
+  bStream[0]:=0; // Avoid initalization hint
+  lBufferedStream:=TBufferedFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  lStream:=TFileStream.Create(TEST_FILENAME,fmOpenRead or fmShareDenyWrite);
+  try
+    // Writeln('Set position=-1');
+    lStream.Position:=-1;
+    // Writeln('TFileStream position=',lStream.Position);
+    lBufferedStream.Position:=-1;
+    // Writeln('Buffered    position=',lBufferedStream.Position);
+    if lStream.Position<>lBufferedStream.Position then begin
+      FAIL('Positions are not the same.');
+    end else begin
+      // Writeln('Positions are the same.');
+    end;
+
+    // Writeln('Read data when position=-1');
+    bread:=lStream.Read(bBuffered[0],10);
+     // Writeln('TFileStream read bytes  : ',bread);
+     // Writeln('TFileStream end position: ',lStream.Position);
+    bread:=lBufferedStream.Read(bStream[0],10);
+     // Writeln('Buffered      read bytes: ',bread);
+     // Writeln('Buffered    end position: ',lBufferedStream.Position);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
+      FAIL('Read data or positions are not the same.');
+    end else begin
+      // Writeln('Read data at -1 is the same.');
+    end;
+
+    // Writeln('Testing Seek operations');
+    // Writeln('Seek -1 from beginning');
+    bread:=lStream.Seek(-1,soBeginning);
+    // Writeln('Stream seek result  : ',bread);
+    bread:=lBufferedStream.Seek(-1,soBeginning);
+    // Writeln('Buffered seek result: ',);
+
+    // Writeln('Read data when Seek -1');
+    bread:=lStream.Read(bBuffered[0],10);
+    // Writeln('TFileStream read bytes  : ',bread);
+    // Writeln('TFileStream end position: ',lStream.Position);
+    bread:=lBufferedStream.Read(bStream[0],10);
+    // Writeln('Buffered      read bytes: ',bread);
+    // Writeln('Buffered    end position: ',lBufferedStream.Position);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
+      FAIL('Read data or positions are not the same.');
+    end else begin
+      // Writeln('Read data at -1 is the same.');
+    end;
+
+    // Writeln('Seek -current*2 from current');
+    bread:=lStream.Seek(lStream.Position*-2,soCurrent);
+    // Writeln('Stream seek result  : ',bread);
+    bread:=lBufferedStream.Seek(lBufferedStream.Position*-2,soCurrent);
+    // Writeln('Buffered seek result: ',bread);
+    // Writeln('Read data when Seek from current -current*2');
+    bread:=lStream.Read(bBuffered[0],10);
+    // Writeln('TFileStream read bytes  : ',bread);
+    // Writeln('TFileStream end position: ',lStream.Position);
+    bread:=lBufferedStream.Read(bStream[0],10);
+    // Writeln('Buffered      read bytes: ',);
+    // Writeln('Buffered    end position: ',lBufferedStream.Position);
+    if (not CompareMem(@bBuffered[0],@bStream[0],10)) or (lStream.Position<>lBufferedStream.Position) then begin
+      FAIL('Read data or positions are not the same.');
+    end else begin
+      // Writeln('Read data at -current*2 is the same.');
+    end;
+  finally
+    lBufferedStream.Free;
+    lStream.Free;
+  end;
+end;
+
+procedure TTestBufferedFileStream.SetUp;
+var
+  F: TFileStream;
+  b: array [0..10000-1] of char;
+  j: integer;
+begin
+  for j := 0 to Pred(10000) do begin
+    b[j]:=char(ord('0')+j mod 10);
+  end;
+  F:=TFileStream.Create(TEST_FILENAME,fmCreate);
+  for j := 0 to Pred(1000) do begin
+    F.Write(b,sizeof(b));
+  end;
+  F.Free;
+end;
+
+procedure TTestBufferedFileStream.TearDown;
+begin
+  DeleteFile(TEST_FILENAME);
+  DeleteFile(TEST_WRITEC_FILE);
+  DeleteFile(TEST_WRITEF_FILE);
+end;
+
+function TTestBufferedFileStream.CompareStreams(const aStream1: TStream;
+  const aStream2: TStream): Boolean;
+const
+  BUFFER_SIZE=5213; // Odd number
+var
+  b1: array [0..BUFFER_SIZE-1] of BYTE;
+  b2: array [0..BUFFER_SIZE-1] of BYTE;
+  lReadBytes: integer;
+  lAvailable: integer;
+  lEffectiveRead1: integer;
+  lEffectiveRead2: integer;
+begin
+  b1[0]:=0; // Avoid initalization hint
+  b2[0]:=0; // Avoid initalization hint
+  Result:=false;
+  if aStream1.Size<>aStream2.Size then exit;
+  aStream1.Position:=0;
+  aStream2.Position:=0;
+  while aStream1.Position<aStream1.Size do begin
+    lAvailable:=aStream1.Size-aStream1.Position;
+    if lAvailable>=BUFFER_SIZE then begin
+      lReadBytes:=BUFFER_SIZE;
+    end else begin
+      lReadBytes:=aStream1.Size-aStream1.Position;
+    end;
+    lEffectiveRead1:=aStream1.Read(b1[0],lReadBytes);
+    lEffectiveRead2:=aStream2.Read(b2[0],lReadBytes);
+    if lEffectiveRead1<>lEffectiveRead2 then exit;
+    if not CompareMem(@b1[0],@b2[0],lEffectiveRead1) then exit;
+  end;
+  Result:=true;
+end;
+
+initialization
+  RegisterTest(TTestBufferedFileStream);
+end.
+