--- Merging r15136 into '.':

U    rtl/objpas/types.pp
--- Merging r15138 into '.':
U    rtl/objpas/classes/streams.inc
A    tests/webtbs/tw16161.pp

# revisions: 15136,15138
------------------------------------------------------------------------
r15136 | marco | 2010-04-11 13:21:39 +0200 (Sun, 11 Apr 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/types.pp

 * removed packed from statstg, which causes trouble in win64, and is probably wrong. Mantis 16159
------------------------------------------------------------------------
------------------------------------------------------------------------
r15138 | paul | 2010-04-11 14:52:31 +0200 (Sun, 11 Apr 2010) | 1 line
Changed paths:
   M /trunk/rtl/objpas/classes/streams.inc
   A /trunk/tests/webtbs/tw16161.pp

rtl: implement TStreamAdapter.CopyTo, .SetSize, return proper error value for Clone instead of raising exception (#0016161) + test
------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@15304 -

.gitattributes

@@ -9503,6 +9503,7 @@ tests/webtbs/tw1573.pp svneol=native#text/plain
 tests/webtbs/tw15821.pp svneol=native#text/plain
 tests/webtbs/tw15909.pp svneol=native#text/plain
 tests/webtbs/tw1592.pp svneol=native#text/plain
+tests/webtbs/tw16161.pp svneol=native#text/pascal
 tests/webtbs/tw1617.pp svneol=native#text/plain
 tests/webtbs/tw1622.pp svneol=native#text/plain
 tests/webtbs/tw1623.pp svneol=native#text/plain

rtl/objpas/classes/streams.inc

@@ -916,18 +916,53 @@ begin
         Result := STG_E_REVERTED;
         Exit;
       end;
-  runerror(217);
+  if libNewSize<0 then
+    begin
+      Result := STG_E_INVALIDFUNCTION;
+      Exit;
+    end;
+  try
+    FStream.Size := libNewSize;
+    Result := S_OK;
+  except
+    // TODO: return different error value according to exception like STG_E_MEDIUMFULL
+    Result := E_FAIL;
+  end;
 end;
 
 
 function TStreamAdapter.CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint; out cbWritten: Largeint): HResult; stdcall;
+var
+  sz: dword;
+  buffer : array[0..1023] of byte;
 begin
   if m_bReverted then
       begin
         Result := STG_E_REVERTED;
         Exit;
       end;
-  runerror(217);
+
+  // the method is similar to TStream.CopyFrom => use CopyFrom implementation
+  cbWritten := 0;
+  cbRead := 0;
+  while cb > 0 do
+    begin
+      if (cb > sizeof(buffer)) then
+        sz := sizeof(Buffer)
+      else
+        sz := cb;
+      sz := FStream.Read(buffer, sz);
+      inc(cbRead, sz);
+      stm.Write(@buffer[0], sz, @sz);
+      inc(cbWritten, sz);
+      if sz = 0 then
+        begin
+          Result := E_FAIL;
+          Exit;
+        end;
+      dec(cb, sz);
+    end;
+  Result := S_OK;
 end;
 
 function TStreamAdapter.Commit(grfCommitFlags: Longint): HResult; stdcall;
@@ -991,7 +1026,9 @@ begin
         Result := STG_E_REVERTED;
         Exit;
       end;
-  runerror(217);
+  // don't raise an exception here return error value that function is not implemented
+  // to implement this we need a clone method for TStream class
+  Result := STG_E_UNIMPLEMENTEDFUNCTION;
 end;
 
 constructor TProxyStream.Create(const Stream: IStream);

rtl/objpas/types.pp

@@ -237,11 +237,7 @@ type
 {$endif Windows}
 
 type
-  tagSTATSTG =
-{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
-  packed
-{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
-  record
+  tagSTATSTG = record
      pwcsName      : POleStr;
      dwType        : DWord;
      cbSize        : Large_uint;

tests/webtbs/tw16161.pp

@@ -0,0 +1,34 @@
+program tw16161;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+uses
+  Classes, ActiveX;
+
+var
+  Stream1: TMemoryStream;
+  _Stream1, _Stream2: IStream;
+  cbRead, cbWritten: LargeInt;
+  NewPos: Int64;
+  buf: array[0..3] of char;
+begin
+  Stream1 := TMemoryStream.Create;
+  Stream1.Write('test', 4);
+  Stream1.Position := 0;
+  _Stream1 := TStreamAdapter.Create(Stream1, soReference);
+  _Stream1.SetSize(3);
+  _Stream2 := TStreamAdapter.Create(TMemoryStream.Create, soOwned);
+  _Stream1.CopyTo(_Stream2, 4, cbRead, cbWritten);
+  _Stream2.Seek(0, STREAM_SEEK_SET, NewPos);
+  if (cbRead <> 3) or (cbWritten <> 3) then
+    halt(1);
+  _Stream2.Read(@buf[0], cbRead, @cbWritten);
+  if (buf[0] <> 't') or (buf[1] <> 'e') or (buf[2] <> 's') then
+    halt(2);
+  if (cbRead <> 3) or (cbWritten <> 3) then
+    halt(3);
+  Stream1.Free;
+end.