Переглянути джерело

rtl: add TBytesStream class for compatibility with delphi (TStringStream is a descendant of TBytesStream) + test

git-svn-id: trunk@19389 -
paul 14 роки тому
батько
коміт
7817f5017d

+ 1 - 0
.gitattributes

@@ -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

+ 12 - 0
rtl/objpas/classes/classesh.inc

@@ -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)

+ 33 - 0
rtl/objpas/classes/streams.inc

@@ -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 - 0
tests/test/units/classes/tbytesstreamtest.pp

@@ -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.