--- Merging r19389 into '.':

U    rtl/objpas/classes/streams.inc
U    rtl/objpas/classes/classesh.inc
A    tests/test/units/classes/tbytesstreamtest.pp
--- Merging r19393 into '.':
G    rtl/objpas/classes/streams.inc
G    rtl/objpas/classes/classesh.inc

# revisions: 19389,19393
------------------------------------------------------------------------
r19389 | paul | 2011-10-06 06:41:10 +0200 (Thu, 06 Oct 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/classesh.inc
   M /trunk/rtl/objpas/classes/streams.inc
   A /trunk/tests/test/units/classes/tbytesstreamtest.pp

rtl: add TBytesStream class for compatibility with delphi (TStringStream is a descendant of TBytesStream) + test 
------------------------------------------------------------------------
------------------------------------------------------------------------
r19393 | florian | 2011-10-06 19:54:44 +0200 (Thu, 06 Oct 2011) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/classesh.inc
   M /trunk/rtl/objpas/classes/streams.inc

* fix compilation on 64 Bit targets
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_6@20020 -

.gitattributes

@@ -10512,6 +10512,7 @@ tests/test/ulib2a.pp svneol=native#text/plain
 tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
 tests/test/umacpas1.pp svneol=native#text/plain
 tests/test/umainnam.pp svneol=native#text/plain
+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

rtl/objpas/classes/classesh.inc

@@ -179,11 +179,11 @@ type
     function MoveNext: Boolean;
     property Current: Pointer read GetCurrent;
   end;
-  
-{$ifdef VER2_4}  
+
+{$ifdef VER2_4}
 type
   TDirection = (FromBeginning, FromEnd);
-{$endif}          
+{$endif}
 
   TFPList = class(TObject)
   private
@@ -205,7 +205,7 @@ type
     procedure SetCount(NewCount: Integer);
     Procedure RaiseIndexError(Index: Integer);
   public
-{$IFNDEF VER2_4}  
+{$IFNDEF VER2_4}
     Type
       TDirection = (FromBeginning, FromEnd);
 {$ENDIF}
@@ -572,7 +572,7 @@ type
     function GetName(Index: Integer): string;
     function GetValue(const Name: string): string;
     Function GetLBS : TTextLineBreakStyle;
-    Procedure SetLBS (AValue : TTextLineBreakStyle); 
+    Procedure SetLBS (AValue : TTextLineBreakStyle);
     procedure ReadData(Reader: TReader);
     procedure SetCommaText(const Value: string);
     procedure SetStringsAdapter(const Value: IStringsAdapter);
@@ -773,7 +773,7 @@ type
   end;
 
 {$endif}
-  
+
 
 { TStream abstract class }
 
@@ -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: PtrInt): Pointer; override;
+  public
+    constructor Create(const ABytes: TBytes); overload;
+    property Bytes: TBytes read FBytes;
+  end;
+
 { TStringStream }
 
   TStringStream = class(TStream)
@@ -1215,7 +1227,7 @@ type
     function ReadIdent: string;
     function ReadInteger: Longint;
     function ReadInt64: Int64;
-    function ReadSet(EnumType: Pointer): Integer; 
+    function ReadSet(EnumType: Pointer): Integer;
     procedure ReadListBegin;
     procedure ReadListEnd;
     function ReadRootComponent(ARoot: TComponent): TComponent;
@@ -1394,7 +1406,7 @@ type
     procedure WriteIdent(const Ident: string);
     procedure WriteInteger(Value: Longint); overload;
     procedure WriteInteger(Value: Int64); overload;
-    procedure WriteSet(Value: LongInt; SetType: Pointer); 
+    procedure WriteSet(Value: LongInt; SetType: Pointer);
     procedure WriteListBegin;
     procedure WriteListEnd;
     procedure WriteRootComponent(ARoot: TComponent);
@@ -1571,7 +1583,7 @@ type
     procedure FreeOnRelease;
   end;
 
-  IInterfaceComponentReference = interface 
+  IInterfaceComponentReference = interface
     ['{3FEEC8E1-E400-4A24-BCAC-1F01476439B1}']
     function GetComponent:TComponent;
    end;
@@ -1665,7 +1677,7 @@ type
     // fpdoc doesn't handle this yet :(
 {$ifndef fpdocsystem}
     function IInterfaceComponentReference.GetComponent=iicrgetcomponent;
-{$endif}    
+{$endif}
     procedure WriteState(Writer: TWriter); virtual;
     constructor Create(AOwner: TComponent); virtual;
     destructor Destroy; override;

rtl/objpas/classes/streams.inc

@@ -667,7 +667,7 @@ function TMemoryStream.Realloc(var NewCapacity: PtrInt): Pointer;
 begin
   If NewCapacity<0 Then
     NewCapacity:=0
-  else  
+  else
     begin
       // if growing, grow at least a quarter
       if (NewCapacity>FCapacity) and (NewCapacity < (5*FCapacity) div 4) then
@@ -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: PtrInt): 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                                *}
@@ -951,7 +984,7 @@ begin
     FreeAndNil(FStream);
   inherited Destroy;
 end;
-  
+
 {$warnings off}
 function TStreamAdapter.Read(pv: Pointer; cb: DWORD; pcbRead: PDWORD): HResult; stdcall;
 var
@@ -1006,10 +1039,10 @@ begin
     STREAM_SEEK_SET: newpos := FStream.Seek(dlibMove, soBeginning);
     STREAM_SEEK_CUR: newpos := FStream.Seek(dlibMove, soCurrent);
     STREAM_SEEK_END: newpos := FStream.Seek(dlibMove, soEnd);
-    else 
-      begin 
-        Result := STG_E_INVALIDFUNCTION; 
-        Exit; 
+    else
+      begin
+        Result := STG_E_INVALIDFUNCTION;
+        Exit;
       end;
   end;
   if @libNewPosition <> nil then
@@ -1112,7 +1145,7 @@ begin
     if @statstg <> nil then
     begin
       fillchar(statstg, sizeof(TStatStg),#0);
-      
+
       { //TODO handle pwcsName
         if grfStatFlag = STATFLAG_DEFAULT then
           runerror(217) //Result :={$ifdef windows} STG_E_INVALIDFLAG{$else}E_INVALID_FLAG{$endif}
@@ -1125,7 +1158,7 @@ begin
     Result := S_OK;
   end else
     Result := STG_E_INVALIDFLAG
-end; 
+end;
 
 function TStreamAdapter.Clone(out stm: IStream): HResult; stdcall;
 begin
@@ -1162,11 +1195,11 @@ end;
 function TProxyStream.GetIStream: IStream;
 begin
   Result := FStream;
-end; 
+end;
 
 procedure TProxyStream.Check(err:integer);
 var e : EInOutError;
-begin 
+begin
   e:= EInOutError.Create('Proxystream.Check');
   e.Errorcode:=err;
   raise e;

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.