mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-23 07:11:29 +02:00
rtl: add TBytesStream class for compatibility with delphi (TStringStream is a descendant of TBytesStream) + test
git-svn-id: trunk@19389 -
This commit is contained in:
parent
85f7914906
commit
7817f5017d
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -10671,6 +10671,7 @@ tests/test/units/character/ttoupper.pp svneol=native#text/pascal
|
||||
tests/test/units/character/ttoupper2.pp svneol=native#text/pascal
|
||||
tests/test/units/character/ttoupper3.pp svneol=native#text/pascal
|
||||
tests/test/units/character/tutf32convert.pp svneol=native#text/pascal
|
||||
tests/test/units/classes/tbytesstreamtest.pp svneol=native#text/pascal
|
||||
tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
|
||||
tests/test/units/classes/tsetstream.pp svneol=native#text/plain
|
||||
tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
|
||||
|
@ -918,6 +918,18 @@ type
|
||||
function Write(const Buffer; Count: LongInt): LongInt; override;
|
||||
end;
|
||||
|
||||
{ TBytesStream }
|
||||
|
||||
TBytesStream = class(TMemoryStream)
|
||||
private
|
||||
FBytes: TBytes;
|
||||
protected
|
||||
function Realloc(var NewCapacity: Longint): Pointer; override;
|
||||
public
|
||||
constructor Create(const ABytes: TBytes); overload;
|
||||
property Bytes: TBytes read FBytes;
|
||||
end;
|
||||
|
||||
{ TStringStream }
|
||||
|
||||
TStringStream = class(TStream)
|
||||
|
@ -755,6 +755,39 @@ begin
|
||||
Result:=Count;
|
||||
end;
|
||||
|
||||
{****************************************************************************}
|
||||
{* TBytesStream *}
|
||||
{****************************************************************************}
|
||||
|
||||
constructor TBytesStream.Create(const ABytes: TBytes);
|
||||
begin
|
||||
inherited Create;
|
||||
FBytes:=ABytes;
|
||||
SetPointer(Pointer(FBytes),Length(FBytes));
|
||||
FCapacity:=Length(FBytes);
|
||||
end;
|
||||
|
||||
function TBytesStream.Realloc(var NewCapacity: Longint): Pointer;
|
||||
begin
|
||||
// adapt TMemoryStream code to use with dynamic array
|
||||
if NewCapacity<0 Then
|
||||
NewCapacity:=0
|
||||
else
|
||||
begin
|
||||
if (NewCapacity>Capacity) and (NewCapacity < (5*Capacity) div 4) then
|
||||
NewCapacity := (5*Capacity) div 4;
|
||||
NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
|
||||
end;
|
||||
if NewCapacity=Capacity then
|
||||
Result:=Pointer(FBytes)
|
||||
else
|
||||
begin
|
||||
SetLength(FBytes,Newcapacity);
|
||||
Result:=Pointer(FBytes);
|
||||
if (Result=nil) and (Newcapacity>0) then
|
||||
raise EStreamError.Create(SMemoryStreamError);
|
||||
end;
|
||||
end;
|
||||
|
||||
{****************************************************************************}
|
||||
{* TStringStream *}
|
||||
|
38
tests/test/units/classes/tbytesstreamtest.pp
Normal file
38
tests/test/units/classes/tbytesstreamtest.pp
Normal file
@ -0,0 +1,38 @@
|
||||
program tbytesstreamtest;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$apptype console}
|
||||
|
||||
uses
|
||||
SysUtils, Classes;
|
||||
|
||||
var
|
||||
BS: TBytesStream;
|
||||
MS: TMemoryStream;
|
||||
B: TBytes;
|
||||
begin
|
||||
B := TBytes.Create(1, 2, 3);
|
||||
BS := TBytesStream.Create(B);
|
||||
WriteLn(BS.Size);
|
||||
|
||||
// save it to regular memory stream
|
||||
MS := TMemoryStream.Create;
|
||||
try
|
||||
BS.SaveToStream(MS);
|
||||
finally
|
||||
BS.Free;
|
||||
end;
|
||||
|
||||
// now restore and compare
|
||||
BS := TBytesStream.Create;
|
||||
try
|
||||
MS.Position := 0;
|
||||
BS.LoadFromStream(MS);
|
||||
B := BS.Bytes;
|
||||
if (Length(B) < 3) or (B[0] <> 1) or (B[1] <> 2) or (B[2] <> 3) then
|
||||
halt(1);
|
||||
finally
|
||||
BS.Free;
|
||||
end;
|
||||
MS.Free;
|
||||
end.
|
Loading…
Reference in New Issue
Block a user