* patch from Thorsten Engler submitted in #8235

git-svn-id: trunk@6272 -

compiler/cgobj.pas

@@ -385,6 +385,7 @@ unit cgobj;
 
           }
           procedure g_copyshortstring(list : TAsmList;const source,dest : treference;len:byte);
+          procedure g_copyvariant(list : TAsmList;const source,dest : treference);
 
           procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
           procedure g_decrrefcount(list : TAsmList;t: tdef; const ref: treference);
@@ -2512,6 +2513,27 @@ implementation
         cgpara1.done;
       end;
 
+    procedure tcg.g_copyvariant(list : TAsmList;const source,dest : treference);
+      var
+        cgpara1,cgpara2 : TCGPara;
+      begin
+        cgpara1.init;
+        cgpara2.init;
+        paramanager.getintparaloc(pocall_default,1,cgpara1);
+        paramanager.getintparaloc(pocall_default,2,cgpara2);
+        paramanager.allocparaloc(list,cgpara2);
+        a_paramaddr_ref(list,dest,cgpara2);
+        paramanager.allocparaloc(list,cgpara1);
+        a_paramaddr_ref(list,source,cgpara1);
+        paramanager.freeparaloc(list,cgpara2);
+        paramanager.freeparaloc(list,cgpara1);
+        allocallcpuregisters(list);
+        a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE');
+        deallocallcpuregisters(list);
+        cgpara2.done;
+        cgpara1.done;
+      end;
+
 
     procedure tcg.g_incrrefcount(list : TAsmList;t: tdef; const ref: treference);
       var

compiler/ncgutil.pas

@@ -896,6 +896,14 @@ implementation
                   include(current_procinfo.flags,pi_do_call);
                   cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef).len)
                 end
+              else if tparavarsym(p).vardef.typ = variantdef then
+                begin
+                  { this code is only executed before the code for the body and the entry/exit code is generated
+                    so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore
+                  }
+                  include(current_procinfo.flags,pi_do_call);
+                  cg.g_copyvariant(list,href,localcopyloc.reference)
+                end
               else
                 begin
                   { pass proper alignment info }
@@ -1154,8 +1162,11 @@ implementation
              vs_value :
                if needs_inittable then
                  begin
-                   location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
-                   cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
+                   { variants are already handled by the call to fpc_variant_copy_overwrite }
+                   if tparavarsym(p).vardef.typ <> variantdef then begin
+                     location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef));
+                     cg.g_incrrefcount(list,tparavarsym(p).vardef,href);
+                   end;
                  end;
              vs_out :
                begin

rtl/inc/compproc.inc

@@ -258,6 +258,7 @@ Procedure fpc_Write_Text_WideChar(Len : Longint;var t : Text;c : WideChar); comp
 
 {$ifdef FPC_HAS_FEATURE_VARIANTS}
 procedure fpc_variant_copy(d,s : pointer);compilerproc;
+procedure fpc_variant_copy_overwrite(source, dest : pointer);compilerproc;
 procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); compilerproc;
 function fpc_variant_to_dynarray(const v : variant;typeinfo : pointer) : pointer;compilerproc;
 function fpc_dynarray_to_variant(dynarr : pointer;typeinfo : pointer) : variant;compilerproc;

rtl/inc/variant.inc

@@ -43,12 +43,19 @@ procedure variant_addref(var v : tvardata);[Public,Alias:'FPC_VARIANT_ADDREF'];
   end;
 
 { using pointers as argument here makes life for the compiler easier }
-procedure fpc_variant_copy(d,s : pointer);compilerproc;
+procedure fpc_variant_copy(d,s : pointer);[Public,Alias:'FPC_VARIANT_COPY']; compilerproc;
   begin
     if assigned(VarCopyProc) then
       VarCopyProc(tvardata(d^),tvardata(s^));
   end;
 
+{ using pointers as argument here makes life for the compiler easier, overwrites target without finalizing }
+procedure fpc_variant_copy_overwrite(source, dest : pointer);[Public,Alias:'FPC_VARIANT_COPY_OVERWRITE']; compilerproc;
+  begin
+    tvardata(dest^).VType := varEmpty;
+    if assigned(VarCopyProc) then
+      VarCopyProc(tvardata(dest^),tvardata(source^));
+  end;
 
 Procedure fpc_write_text_variant(Len : Longint;var f : Text;const v : variant); iocheck; [Public,Alias:'FPC_WRITE_TEXT_VARIANT']; compilerproc;
   begin