Patch. TStrings.LoadFromStream does not work correctly with large files on x64
Original Reporter info from Mantis: SergeAnvarov @SergeAnvarov
-
Reporter name: Serge Anvarov
Original Reporter info from Mantis: SergeAnvarov @SergeAnvarov
- Reporter name: Serge Anvarov
Description:
This is true only for 64-bit systems. We are talking about files of size 2GB or more. In 32 bit such files and so will not fit in memory.
In LoadFromStream there are two errors:
- Variables of type SizeInt are used, although the Read procedure only understands LongInt. As a result of the overflow, negative values are already passed to it.
- The upper limit of the unit size for reading is set to 2**38, which also exceeds the LongInt size.
In "Steps To Reproduce" given the project that is load strings from large zeroed stream. In order to avoid creating such large files, implement simple class TFilledZerosStream.
Patch included.
Steps to reproduce:
{$APPTYPE CONSOLE}
{$MODE OBJFPC}
{$LONGSTRINGS ON}
uses Math, Classes;
type
TFilledZerosStream = class(TStream)
strict private
FSize: Int64;
FPosition: Int64;
protected
function GetSize: Int64; override;
function GetPosition: Int64; override;
public
function Read(var Buffer; Count: LongInt): LongInt; override;
function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;
constructor Create(ASize: Int64);
end;
constructor TFilledZerosStream.Create(ASize: Int64);
begin
inherited Create;
if ASize > 0 then
FSize := ASize;
end;
function TFilledZerosStream.GetPosition: Int64;
begin
Result := FPosition;
end;
function TFilledZerosStream.GetSize: Int64;
begin
Result := FSize;
end;
function TFilledZerosStream.Read(var Buffer; Count: LongInt): LongInt;
var
Rest: Int64;
begin
Result := 0;
if (Count > 0) and InRange(FPosition, 0, FSize - 1) then // TRUE: FSize > 0
begin
Result := Count;
// Avoid overflow with an intermediate variable of type int64
Rest := FSize - FPosition;
If Result > Rest then
Result := LongInt(Rest);
FillChar(Buffer, Result, 0);
Inc(FPosition, Result);
end;
end;
function TFilledZerosStream.Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;
begin
// Avoid overflow by check value before addition
case Origin of
soBeginning:
FPosition := EnsureRange(Offset, 0, FSize);
soEnd:
FPosition := FSize + EnsureRange(Offset, -FSize, 0);
soCurrent:
FPosition := FPosition + EnsureRange(Offset, -FPosition, FSize - FPosition);
end;
Result := FPosition;
end;
// Corrected version of TStrings.LoadFromStream
procedure LoadFromStream(Self: TStrings; Stream: TStream);
{
Borlands method is no good, since a pipe for
instance doesn't have a size.
So we must do it the hard way.
}
Const
BufSize = 1024;
Var
Buffer : AnsiString;
BytesRead: LongInt;
BufLen: SizeInt;
I,BufDelta : LongInt;
begin
// reread into a buffer
Self.beginupdate;
try
Buffer:='';
BufLen:=0;
I:=1;
Repeat
BufDelta:=BufSize*I;
SetLength(Buffer,BufLen+BufDelta);
BytesRead:=Stream.Read(Buffer[BufLen+1],BufDelta);
Inc(BufLen, BufDelta);
if BufDelta < (MaxInt div 2) then
I:=I shl 1;
Until BytesRead<>BufDelta;
SetLength(Buffer, BufLen-BufDelta+BytesRead);
Self.Text := Buffer;
SetLength(Buffer,0);
finally
Self.EndUpdate;
end;
end;
var
L: TStringList;
Z: TFilledZerosStream;
begin
L := TStringList.Create;
try
Z := TFilledZerosStream.Create(MaxInt);
try
//L.LoadFromStream(Z); // Pos=2147482624, rest=1023
LoadFromStream(L, Z); // Pos=2147483647, rest=0
Writeln('Pos=', Z.Position, ', rest=', Z.Size - Z.Position);
finally
Z.Free;
end;
finally
L.Free;
end;
Readln;
end.
Additional information:
This error also exists in FPC 3.0.4. But it implementation of TStrings and so does not know how to work with large files.
Mantis conversion info:
- Mantis ID: 35817
- Version: 3.3.1
- Fixed in version: 3.3.1
- Fixed in revision: 42351 (#a516b6fd)
- Monitored by: » Vincent (Vincent Snijders), » @PascalRiekenberg (Pascal Riekenberg)
- Target version: 3.2.0