2
0
Эх сурвалжийг харах

* merge revs

git-svn-id: branches/fixes_3_2@43196 -
marco 5 жил өмнө
parent
commit
65ae9d2413

+ 1 - 0
.gitattributes

@@ -2005,6 +2005,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/src/wtex.pp svneol=native#text/plain
 packages/fcl-base/tests/fclbase-unittests.lpi 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/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/tccsvreadwrite.pp svneol=native#text/plain
 packages/fcl-base/tests/tchashlist.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/tests/tcinifile.pp svneol=native#text/plain

+ 591 - 3
packages/fcl-base/src/bufstream.pp

@@ -3,6 +3,7 @@
     Copyright (c) 1999-2000 by the Free Pascal development team
     Copyright (c) 1999-2000 by the Free Pascal development team
 
 
     Implement a buffered stream.
     Implement a buffered stream.
+    TBufferedFileStream contributed by José Mejuto, bug ID 30549.
 
 
     See the file COPYING.FPC, included in this distribution,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     for details about the copyright.
@@ -27,8 +28,10 @@ Const
 
 
 Type
 Type
 
 
+{ ---------------------------------------------------------------------
+  TBufStream - simple read or write buffer, for sequential reading/writing
+  ---------------------------------------------------------------------}
 
 
-  { TBufStream }
   TBufStream = Class(TOwnerStream)
   TBufStream = Class(TOwnerStream)
   Private
   Private
     FTotalPos : Int64;
     FTotalPos : Int64;
@@ -70,12 +73,83 @@ Type
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
     Function Write(Const ABuffer; ACount : LongInt) : Integer; override;
   end;
   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
 implementation
 
 
 Resourcestring
 Resourcestring
-  SErrCapacityTooSmall = 'Capacity is less than actual buffer size.';
+  SErrCapacityTooSmall    = 'Capacity is less than actual buffer size.';
   SErrCouldNotFLushBuffer = 'Could not flush buffer';
   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 }
 { TBufStream }
 
 
@@ -257,4 +331,518 @@ begin
 end;
 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.
 end.

+ 4 - 2
packages/fcl-base/src/csvreadwrite.pp

@@ -124,7 +124,7 @@ Type
     // simple parsing
     // simple parsing
     procedure ParseValue;
     procedure ParseValue;
   public
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
     // Source data stream
     // Source data stream
     procedure SetSource(AStream: TStream); overload;
     procedure SetSource(AStream: TStream); overload;
@@ -161,7 +161,7 @@ Type
     procedure AppendStringToStream(const AString: String; AStream: TStream);
     procedure AppendStringToStream(const AString: String; AStream: TStream);
     function  QuoteCSVString(const AValue: String): String;
     function  QuoteCSVString(const AValue: String): String;
   public
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
     destructor Destroy; override;
     // Set output/destination stream.
     // Set output/destination stream.
     // If not called, output is sent to DefaultOutput
     // If not called, output is sent to DefaultOutput
@@ -455,6 +455,7 @@ var
   b: packed array[0..2] of byte;
   b: packed array[0..2] of byte;
   n: Integer;
   n: Integer;
 begin
 begin
+  B[0]:=0; B[1]:=0; B[2]:=0;
   ClearOutput;
   ClearOutput;
   FSourceStream.Seek(0, soFromBeginning);
   FSourceStream.Seek(0, soFromBeginning);
   if FDetectBOM then
   if FDetectBOM then
@@ -533,6 +534,7 @@ begin
   if StreamSize > 0 then
   if StreamSize > 0 then
   begin
   begin
     SetLength(Result, StreamSize);
     SetLength(Result, StreamSize);
+    FDefaultOutput.Position:=0;
     FDefaultOutput.ReadBuffer(Result[1], StreamSize);
     FDefaultOutput.ReadBuffer(Result[1], StreamSize);
   end;
   end;
 end;
 end;

+ 2 - 9
packages/fcl-base/src/inifiles.pp

@@ -1381,17 +1381,10 @@ begin
       if FEncoding=nil then
       if FEncoding=nil then
         slLines.LoadFromFile(FFileName)
         slLines.LoadFromFile(FFileName)
       else
       else
-      begin
-        slLines.DefaultEncoding := FEncoding;
-        slLines.LoadFromFile(FFileName, nil);
-        if FEncoding <> slLines.Encoding then
         begin
         begin
-          if FOwnsEncoding then
-            FEncoding.Free;
-          FEncoding := slLines.Encoding;
-          FOwnsEncoding := not TEncoding.IsStandardEncoding(FEncoding);
+        slLines.DefaultEncoding := FEncoding; // TStrings clones the encoding.
+        slLines.LoadFromFile(FFileName, nil);
         end;
         end;
-      end;
       FillSectionList(slLines);
       FillSectionList(slLines);
     finally
     finally
       slLines.Free;
       slLines.Free;

+ 2 - 1
packages/fcl-base/src/maskutils.pp

@@ -308,7 +308,6 @@ end;
 // Clear (virtually) a single char in position Position
 // Clear (virtually) a single char in position Position
 function TMaskUtils.ClearChar(Position: Integer): Char;
 function TMaskUtils.ClearChar(Position: Integer): Char;
 begin
 begin
-  Result := FMask[Position];
   //For Delphi compatibilty, only literals remain, all others will be blanked
   //For Delphi compatibilty, only literals remain, all others will be blanked
   case CharToMask(FMask[Position]) Of
   case CharToMask(FMask[Position]) Of
     Char_Number,
     Char_Number,
@@ -334,6 +333,8 @@ begin
     Char_AllFixedDownCase: Result := FSpaceChar;
     Char_AllFixedDownCase: Result := FSpaceChar;
     Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator;
     Char_HourSeparator: Result := DefaultFormatSettings.TimeSeparator;
     Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator;
     Char_DateSeparator: Result := DefaultFormatSettings.DateSeparator;
+  else
+    Result := FMask[Position];
   end;
   end;
 end;
 end;
 
 

+ 27 - 29
packages/fcl-base/src/streamex.pp

@@ -181,35 +181,33 @@ type
 
 
 
 
   TStreamHelper = class helper for TStream
   TStreamHelper = class helper for TStream
-
-                     function  ReadWordLE :word;
-                     function  ReadDWordLE:dword;
-                     function  ReadQWordLE:qword;
-                     procedure WriteWordLE (w:word);
-  		     procedure WriteDWordLE(dw:dword);
-	             procedure WriteQWordLE(dq:qword);
-                     function  ReadWordBE :word;
-                     function  ReadDWordBE:dword;
-                     function  ReadQWordBE:qword;
-                     procedure WriteWordBE (w:word);
-  		     procedure WriteDWordBE(dw:dword);
-	             procedure WriteQWordBE(dq:qword);
-                     function  ReadSingle:Single;
-                     function  ReadDouble:Double;
-                     procedure WriteSingle(s:Single);
-                     procedure WriteDouble(d:double);
-
-                     {$ifndef FPC}
-                      function ReadByte  : Byte;
-                      function ReadWord  : Word;
-                      function ReadDWord : DWord;
-                      function ReadQWord : QWord;
-                      procedure WriteByte  (b : Byte);
-                      procedure WriteWord  (b : word);
-                      procedure WriteDWord (b : DWord);
-                      procedure WriteQWord (b : QWord);
-                     {$endif}
-                     end;
+    function  ReadWordLE :word;
+    function  ReadDWordLE:dword;
+    function  ReadQWordLE:qword;
+    procedure WriteWordLE (w:word);
+    procedure WriteDWordLE(dw:dword);
+    procedure WriteQWordLE(dq:qword);
+    function  ReadWordBE :word;
+    function  ReadDWordBE:dword;
+    function  ReadQWordBE:qword;
+    procedure WriteWordBE (w:word);
+    procedure WriteDWordBE(dw:dword);
+    procedure WriteQWordBE(dq:qword);
+    function  ReadSingle:Single;
+    function  ReadDouble:Double;
+    procedure WriteSingle(s:Single);
+    procedure WriteDouble(d:double);
+    {$ifndef FPC}
+    function ReadByte  : Byte;
+    function ReadWord  : Word;
+    function ReadDWord : DWord;
+    function ReadQWord : QWord;
+    procedure WriteByte  (b : Byte);
+    procedure WriteWord  (b : word);
+    procedure WriteDWord (b : DWord);
+    procedure WriteQWord (b : QWord);
+    {$endif}
+  end;
 
 
 Implementation
 Implementation
 
 

+ 16 - 10
packages/fcl-base/tests/fclbase-unittests.lpi

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

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

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

+ 393 - 0
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.
+

+ 26 - 10
packages/fcl-net/src/netdb.pp

@@ -1033,7 +1033,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String) : Integer;
+Function ResolveAddressAt(Resolver : Integer; Address : String; Var Names : Array of String; Recurse: Integer) : Integer;
 
 
 
 
 Var
 Var
@@ -1056,13 +1056,29 @@ begin
     I:=0;
     I:=0;
     While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
     While (I<=MaxAnswer) and NextRR(Ans.Payload,AnsStart,AnsLen,RR) do
       begin
       begin
-      if (Ntohs(RR.AType)=DNSQRY_PTR) and (1=NtoHS(RR.AClass)) then
-        begin
-        Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
-        inc(Result);
-        RR.RDLength := ntohs(RR.RDLength);
-        Inc(AnsStart,RR.RDLength);
-        end;
+      Case Ntohs(RR.AType) of
+        DNSQRY_PTR:
+          if (1=NtoHS(RR.AClass)) then
+            begin
+            Names[i]:=BuildName(Ans.Payload,AnsStart,AnsLen);
+            inc(Result);
+            RR.RDLength := ntohs(RR.RDLength);
+            Inc(AnsStart,RR.RDLength);
+            end;
+        DNSQRY_CNAME:
+          begin
+          if Recurse >= MaxRecursion then
+            begin
+            Result := -1;
+            exit;
+            end;
+          rr.rdlength := ntohs(rr.rdlength);
+          setlength(Address, rr.rdlength);
+          address := stringfromlabel(ans.payload, ansstart);
+          Result := ResolveAddressAt(Resolver, Address, Names, Recurse+1);
+          exit;
+          end;
+      end;
       Inc(I);
       Inc(I);
       end;  
       end;  
     end;
     end;
@@ -1084,7 +1100,7 @@ begin
   S:=Format('%d.%d.%d.%d.in-addr.arpa',[nt.s_bytes[4],nt.s_bytes[3],nt.s_bytes[2],nt.s_bytes[1]]);
   S:=Format('%d.%d.%d.%d.in-addr.arpa',[nt.s_bytes[4],nt.s_bytes[3],nt.s_bytes[2],nt.s_bytes[1]]);
   While (Result=0) and (I<=high(DNSServers)) do
   While (Result=0) and (I<=high(DNSServers)) do
     begin
     begin
-    Result:=ResolveAddressAt(I,S,Addresses);
+    Result:=ResolveAddressAt(I,S,Addresses,1);
     Inc(I);
     Inc(I);
     end;
     end;
 end;
 end;
@@ -1111,7 +1127,7 @@ begin
   I := 0;
   I := 0;
   While (Result=0) and (I<=high(DNSServers)) do
   While (Result=0) and (I<=high(DNSServers)) do
     begin
     begin
-    Result:=ResolveAddressAt(I,S,Addresses);
+    Result:=ResolveAddressAt(I,S,Addresses,1);
     Inc(I);
     Inc(I);
     end;
     end;
 end;
 end;

+ 1 - 3
packages/openssl/src/openssl.pas

@@ -1156,7 +1156,7 @@ var
   procedure ErrClearError;
   procedure ErrClearError;
   procedure ErrFreeStrings;
   procedure ErrFreeStrings;
   procedure ErrRemoveState(pid: cInt);
   procedure ErrRemoveState(pid: cInt);
-  procedure RandScreen;
+  procedure RandScreen; deprecated 'Deprecated as of 1.1+';
   function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
   function d2iPKCS12bio(b:PBIO; Pkcs12: SslPtr): SslPtr;
   function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
   function PKCS12parse(p12: SslPtr; pass: string; var pkey, cert, ca: SslPtr): cInt;
   procedure PKCS12free(p12: SslPtr);
   procedure PKCS12free(p12: SslPtr);
@@ -5663,8 +5663,6 @@ begin
       _SslLoadErrorStrings;
       _SslLoadErrorStrings;
     if assigned(_OPENSSLaddallalgorithms) then
     if assigned(_OPENSSLaddallalgorithms) then
       _OPENSSLaddallalgorithms;
       _OPENSSLaddallalgorithms;
-    if assigned(_RandScreen) then
-      _RandScreen;
     if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
     if assigned(_CRYPTOnumlocks) and assigned(_CRYPTOsetlockingcallback) then
       InitLocks;
       InitLocks;
     SSLloaded := True;
     SSLloaded := True;

+ 12 - 0
utils/fpdoc/dw_html.pp

@@ -145,6 +145,8 @@ type
     procedure DescrEndItalic; override;
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
@@ -1101,6 +1103,16 @@ begin
   PopOutputNode;
   PopOutputNode;
 end;
 end;
 
 
+procedure THTMLWriter.DescrBeginUnderline;
+begin
+  PushOutputNode(CreateEl(CurOutputNode, 'u'));
+end;
+
+procedure THTMLWriter.DescrEndUnderline;
+begin
+  PopOutputNode;
+end;
+
 procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 procedure THTMLWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString);
 
 
 Var
 Var

+ 12 - 0
utils/fpdoc/dw_latex.pp

@@ -87,6 +87,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
@@ -287,6 +289,16 @@ begin
   Write('}');
   Write('}');
 end;
 end;
 
 
+procedure TLaTeXWriter.DescrBeginUnderline;
+begin
+  Write('\underline{');
+end;
+
+procedure TLaTeXWriter.DescrEndUnderline;
+begin
+  Write('}');
+end;
+
 procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); 
 procedure TLaTeXWriter.DescrWriteImageEl(const AFileName, ACaption, ALinkName : DOMString); 
 
 
 Var
 Var

+ 12 - 0
utils/fpdoc/dw_linrtf.pp

@@ -121,6 +121,8 @@ type
     procedure DescrEndItalic; override;
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -344,6 +346,16 @@ begin
   Write('}')
   Write('}')
 end;
 end;
 
 
+procedure TRTFWriter.DescrBeginUnderline;
+begin
+  Write('{\ul ');
+end;
+
+procedure TRTFWriter.DescrEndUnderline;
+begin
+  Write('}');
+end;
+
 procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
 procedure TRTFWriter.DescrWriteFileEl(const AText: DOMString);
 begin
 begin
   Write('{\f0 ');
   Write('{\f0 ');

+ 13 - 0
utils/fpdoc/dw_man.pp

@@ -138,6 +138,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -425,6 +427,17 @@ begin
   NewLine;
   NewLine;
 end;
 end;
 
 
+procedure TManWriter.DescrBeginUnderline;
+begin
+  NewLine;
+  Write('.I '); //use ITALIC!
+end;
+
+procedure TManWriter.DescrEndUnderline;
+begin
+  NewLine;
+end;
+
 procedure TManWriter.DescrWriteFileEl(const AText: DOMString);
 procedure TManWriter.DescrWriteFileEl(const AText: DOMString);
 
 
 Var
 Var

+ 10 - 0
utils/fpdoc/dw_txt.pp

@@ -89,6 +89,8 @@ Type
     procedure DescrEndItalic; override;
     procedure DescrEndItalic; override;
     procedure DescrBeginEmph; override;
     procedure DescrBeginEmph; override;
     procedure DescrEndEmph; override;
     procedure DescrEndEmph; override;
+    procedure DescrBeginUnderline; override;
+    procedure DescrEndUnderline; override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteFileEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteKeywordEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
     procedure DescrWriteVarEl(const AText: DOMString); override;
@@ -270,6 +272,14 @@ procedure TTXTWriter.DescrEndEmph;
 begin
 begin
 end;
 end;
 
 
+procedure TTXTWriter.DescrBeginUnderline;
+begin
+end;
+
+procedure TTXTWriter.DescrEndUnderline;
+begin
+end;
+
 procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString);
 procedure TTXTWriter.DescrWriteFileEl(const AText: DOMString);
 begin
 begin
   DescrWriteText(AText);
   DescrWriteText(AText);

+ 8 - 0
utils/fpdoc/dwriter.pp

@@ -117,6 +117,8 @@ type
     procedure DescrEndBold; virtual; abstract;
     procedure DescrEndBold; virtual; abstract;
     procedure DescrBeginItalic; virtual; abstract;
     procedure DescrBeginItalic; virtual; abstract;
     procedure DescrEndItalic; virtual; abstract;
     procedure DescrEndItalic; virtual; abstract;
+    procedure DescrBeginUnderline; virtual; abstract;
+    procedure DescrEndUnderline; virtual; abstract;
     procedure DescrBeginEmph; virtual; abstract;
     procedure DescrBeginEmph; virtual; abstract;
     procedure DescrEndEmph; virtual; abstract;
     procedure DescrEndEmph; virtual; abstract;
     procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual; 
     procedure DescrWriteImageEl(const AFileName, ACaption,ALinkName : DOMString); virtual; 
@@ -637,6 +639,12 @@ begin
       ConvertBaseShortList(AContext, Node, False);
       ConvertBaseShortList(AContext, Node, False);
       DescrEndEmph;
       DescrEndEmph;
     end else
     end else
+    if Node.NodeName = 'u' then
+    begin
+      DescrBeginUnderline;
+      ConvertBaseShortList(AContext, Node, False);
+      DescrEndUnderline;
+    end else
     if Node.NodeName = 'file' then
     if Node.NodeName = 'file' then
       DescrWriteFileEl(ConvertTextContent)
       DescrWriteFileEl(ConvertTextContent)
     else if Node.NodeName = 'kw' then
     else if Node.NodeName = 'kw' then