From 5bf51c991c32d8b64bbe8ed792be0e1117fbdcfa Mon Sep 17 00:00:00 2001
From: sergei <gorelkin@nanoreflex.ru>
Date: Thu, 9 Dec 2010 16:38:55 +0000
Subject: [PATCH] * VarUtils, fixed missing support for interfaces -
 NoInterfaces() not used anymore, removed + Basic test for VariantArray of
 IInterface

git-svn-id: trunk@16527 -
---
 .gitattributes                               |  1 +
 rtl/objpas/cvarutil.inc                      | 10 ----
 rtl/objpas/varutils.inc                      | 10 +++-
 tests/test/units/variants/tvararrayofintf.pp | 61 ++++++++++++++++++++
 4 files changed, 69 insertions(+), 13 deletions(-)
 create mode 100644 tests/test/units/variants/tvararrayofintf.pp

diff --git a/.gitattributes b/.gitattributes
index 932ecba6a8..bdb7c081a0 100644
--- a/.gitattributes
+++ b/.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
diff --git a/rtl/objpas/cvarutil.inc b/rtl/objpas/cvarutil.inc
index 485a3515ae..64d9652905 100644
--- a/rtl/objpas/cvarutil.inc
+++ b/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);
diff --git a/rtl/objpas/varutils.inc b/rtl/objpas/varutils.inc
index d9fc8c3bae..16dfa2bcbf 100644
--- a/rtl/objpas/varutils.inc
+++ b/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
diff --git a/tests/test/units/variants/tvararrayofintf.pp b/tests/test/units/variants/tvararrayofintf.pp
new file mode 100644
index 0000000000..088649bbad
--- /dev/null
+++ b/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.
\ No newline at end of file