* Patch to allow changing TVarRec data (bug ID 26773)

git-svn-id: trunk@28995 -

packages/rtl-objpas/src/inc/variants.pp

@@ -173,7 +173,7 @@ type
     function LeftPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean; virtual;
     function RightPromotion(const V: TVarData; const Operation: TVarOp; out RequiredVarType: TVarType): Boolean; virtual;
     function OlePromotion(const V: TVarData; out RequiredVarType: TVarType): Boolean; virtual;
-    procedure DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); virtual;
+    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); virtual;
     procedure VarDataInit(var Dest: TVarData);
     procedure VarDataClear(var Dest: TVarData);
     procedure VarDataCopy(var Dest: TVarData; const Source: TVarData);
@@ -219,13 +219,13 @@ type
       const Arguments: TVarDataArray): Boolean;
     function GetProperty(var Dest: TVarData; const V: TVarData;
       const Name: string): Boolean;
-    function SetProperty(const V: TVarData; const Name: string;
+    function SetProperty(var V: TVarData; const Name: string;
       const Value: TVarData): Boolean;
   end;
 
   TInvokeableVariantType = class(TCustomVariantType, IVarInvokeable)
   protected
-    procedure DispInvoke(Dest: PVarData; const Source: TVarData;
+    procedure DispInvoke(Dest: PVarData; var Source: TVarData;
       CallDesc: PCallDesc; Params: Pointer); override;
   public
     { IVarInvokeable }
@@ -235,7 +235,7 @@ type
       const Arguments: TVarDataArray): Boolean; virtual;
     function GetProperty(var Dest: TVarData; const V: TVarData;
       const Name: string): Boolean; virtual;
-    function SetProperty(const V: TVarData; const Name: string;
+    function SetProperty(var V: TVarData; const Name: string;
       const Value: TVarData): Boolean; virtual;
   end;
 
@@ -251,7 +251,7 @@ type
   public
     function GetProperty(var Dest: TVarData; const V: TVarData;
       const Name: string): Boolean; override;
-    function SetProperty(const V: TVarData; const Name: string;
+    function SetProperty(var V: TVarData; const Name: string;
       const Value: TVarData): Boolean; override;
   end;
 
@@ -2523,7 +2523,7 @@ begin
 end;
 
 
-procedure sysdispinvoke(Dest : PVarData; const Source : TVarData;calldesc : pcalldesc;params : Pointer);cdecl;
+procedure sysdispinvoke(Dest : PVarData; var source : TVarData;calldesc : pcalldesc;params : Pointer);cdecl;
 var
   temp  : TVarData;
   tempp : ^TVarData;
@@ -3726,7 +3726,7 @@ begin
 end;
 
 
-procedure TCustomVariantType.DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+procedure TCustomVariantType.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
 
 begin
   RaiseDispError;
@@ -3992,7 +3992,7 @@ end;
     TInvokeableVariantType implementation
   ---------------------------------------------------------------------}
 
-procedure TInvokeableVariantType.DispInvoke(Dest: PVarData; const Source: TVarData;
+procedure TInvokeableVariantType.DispInvoke(Dest: PVarData; var Source: TVarData;
   CallDesc: PCallDesc; Params: Pointer);
 var
   method_name: ansistring;
@@ -4123,7 +4123,7 @@ function TInvokeableVariantType.GetProperty(var Dest: TVarData; const V: TVarDat
   end;
 
 
-function TInvokeableVariantType.SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean;
+function TInvokeableVariantType.SetProperty(var V: TVarData; const Name: string; const Value: TVarData): Boolean;
   begin
     result := False;
   end;
@@ -4140,7 +4140,7 @@ function TPublishableVariantType.GetProperty(var Dest: TVarData; const V: TVarDa
   end;
 
 
-function TPublishableVariantType.SetProperty(const V: TVarData; const Name: string; const Value: TVarData): Boolean;
+function TPublishableVariantType.SetProperty(var V: TVarData; const Name: string; const Value: TVarData): Boolean;
   begin
     Result:=true;
     SetPropValue(getinstance(v),name,Variant(value));

rtl/inc/compproc.inc

@@ -507,7 +507,7 @@ function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
 function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
 procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
 procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
-procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
+procedure fpc_dispinvoke_variant(dest : pvardata;var source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
 {$endif FPC_HAS_FEATURE_VARIANTS}
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}

rtl/inc/variant.inc

@@ -142,7 +142,7 @@ function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
   end;
 
 
-procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;
+procedure fpc_dispinvoke_variant(dest : pvardata;var source : tvardata;
   calldesc : pcalldesc;params : pointer); compilerproc;
   begin
   	variantmanager.dispinvoke(dest,source,calldesc,params);

rtl/inc/varianth.inc

@@ -204,7 +204,7 @@ type
       varcast : procedure(var dest : variant;const source : variant;vartype : longint);
       varcastole : procedure(var dest : variant; const source : variant;vartype : longint);
 
-      dispinvoke: procedure(dest : pvardata;const source : tvardata;
+      dispinvoke: procedure(dest : pvardata;var source : tvardata;
         calldesc : pcalldesc;params : pointer);cdecl;
 
       vararrayredim : procedure(var a : variant;highbound : SizeInt);

rtl/java/jcompproc.inc

@@ -531,7 +531,7 @@ function fpc_variant_to_idispatch(const v : variant) : idispatch;compilerproc;
 function fpc_idispatch_to_variant(const i : idispatch) : variant;compilerproc;
 procedure fpc_vararray_get(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
 procedure fpc_vararray_put(var d : variant;const s : variant;indices : plongint;len : sizeint);compilerproc;
-procedure fpc_dispinvoke_variant(dest : pvardata;const source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
+procedure fpc_dispinvoke_variant(dest : pvardata;var source : tvardata;  calldesc : pcalldesc;params : pointer);compilerproc;
 {$endif FPC_HAS_FEATURE_VARIANTS}
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}

tests/webtbs/tw17904.pas

@@ -8,7 +8,7 @@ type
   TTest = class(TCustomVariantType)
     procedure Clear(var V: TVarData); override;
     procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean); override;
-    procedure DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
+    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
   end;
 
 procedure TTest.Clear(var V: TVarData);
@@ -19,7 +19,7 @@ procedure TTest.Copy(var Dest: TVarData; const Source: TVarData; const Indirect:
 begin
 end;
 
-procedure TTest.DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+procedure TTest.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
 var
   tmp: Word;
 begin

tests/webtbs/tw9162.pp

@@ -11,7 +11,7 @@ type
   protected
     procedure Clear(var V: TVarData); override;
     procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
-    procedure DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
+    procedure DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer); override;
   end;
 
 procedure TSampleVariant.Clear(var V: TVarData);
@@ -30,7 +30,7 @@ end;
 var
   p : pointer;
 
-procedure TSampleVariant.DispInvoke(Dest: PVarData; const Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
+procedure TSampleVariant.DispInvoke(Dest: PVarData; var Source: TVarData; CallDesc: PCallDesc; Params: Pointer);
 begin
   Writeln('Dest is 0x', IntToStr(Cardinal(Dest)));
   p:=Dest;