* VarUtils, fixed missing support for interfaces

- NoInterfaces() not used anymore, removed
+ Basic test for VariantArray of IInterface

git-svn-id: trunk@16527 -

.gitattributes

@@ -9910,6 +9910,7 @@ tests/test/units/sysutils/trwsync.pp svneol=native#text/plain
 tests/test/units/sysutils/tsscanf.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
+tests/test/units/variants/tvararrayofintf.pp svneol=native#text/plain
 tests/test/uobjc24.pp svneol=native#text/plain
 tests/test/uobjc26.pp svneol=native#text/plain
 tests/test/uobjc27a.pp svneol=native#text/plain

rtl/objpas/cvarutil.inc

@@ -13,16 +13,6 @@
 
  **********************************************************************}
 
-Resourcestring
-
-  SNoInterfaces  = 'No interfaces supported';
-
-Procedure NoInterfaces;
-
-begin
-  Raise Exception.Create(SNoInterfaces);
-end;
-
 Procedure VariantTypeMismatch; overload;
 begin
   Raise EVariantError.CreateCode(VAR_TYPEMISMATCH);

rtl/objpas/varutils.inc

@@ -156,7 +156,7 @@ begin
       varVariant  : Variant(VargDest):=Variant(PVarData(VPointer)^);
       varOleStr   : CopyAsWideString(VargDest.VOleStr,PVarData(VPointer)^.VoleStr);
       varDispatch,
-      varUnknown  : NoInterfaces;
+      varUnknown  : IInterface(VargDest.vUnknown):=IInterface(PInterface(VargSrc.VPointer)^);
       else
         Exit(VAR_BADVARTYPE);
       end;
@@ -737,9 +737,11 @@ begin
       vatNormal:
         Move(P^, Data^, psa^.ElementSize);
       vatInterface:
-        NoInterfaces; // Just assign...
+        IInterface(PInterface(Data)^) := IInterface(PInterface(P)^);
       vatWideString:
         CopyAsWideString(PWideChar(Data^), PWideChar(P^));
+      vatVariant:
+        VariantCopy(PVarData(Data)^, PVarData(P)^);
     end;
   except
     On E : Exception do
@@ -762,9 +764,11 @@ begin
       vatNormal:
         Move(Data^,P^,psa^.ElementSize);
       vatInterface:
-        NoInterfaces;
+        IInterface(PInterface(P)^):=IInterface(Data);
       vatWideString:
         CopyAsWideString(PWideChar(P^), PWideChar(Data));
+      vatVariant:
+        VariantCopy(PVarData(P)^, PVarData(Data)^);    // !! Untested
     end;
   except
     On E : Exception do

tests/test/units/variants/tvararrayofintf.pp

@@ -0,0 +1,61 @@
+
+// Tests storing interfaces in VariantArray
+{$ifdef fpc}{$mode objfpc}{$h+}{$endif}
+{$apptype console}
+
+uses sysutils, variants;
+
+type
+  ITag = interface(IInterface)['{26EBC417-D394-4561-906A-202F32A919EA}']
+    function GetTag: Integer;
+  end;
+
+  tmyobj=class(TInterfacedObject,ITag)
+  private
+    FTag: Integer;
+    function GetTag: Integer;
+  public
+    constructor Create(aTag: Integer);
+    destructor Destroy; override;
+  end;
+
+var
+  FreeCount: Integer;
+
+constructor tmyobj.create(aTag: Integer);
+begin
+  inherited Create;
+  FTag:=aTag;
+end;
+
+destructor tmyobj.destroy;
+begin
+  writeln('Destroy: ', FTag);
+  Inc(FreeCount);
+  inherited;
+end;
+
+function tmyobj.gettag: integer;
+begin
+  result:=FTag;
+end;
+
+var
+  values: Variant;
+  i: Integer;
+
+begin
+  Values := VarArrayCreate([0, 4], varUnknown);
+  for i := 0 to 4 do
+    Values[i] := tmyobj.Create(i) as IInterface;
+  for i := 0 to 4 do
+  begin
+    if (IInterface(Values[i]) as ITag).GetTag <> i then
+      Halt(i);
+  end;
+  FreeCount := 0;
+  Values := 0;
+  writeln(FreeCount);
+  // check for correct number of destroyed objects won't work because one of them
+  // is released after this point.
+end.