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

git-svn-id: trunk@28995 -
This commit is contained in:
michael 2014-11-05 22:17:54 +00:00
parent 6a83f32486
commit 3563944752
7 changed files with 18 additions and 18 deletions

View File

@ -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));

View File

@ -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}

View File

@ -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);

View File

@ -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);

View File

@ -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}

View File

@ -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

View File

@ -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;