paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 07:59:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Test for bug ID #26773

Browse Source 
git-svn-id: trunk@28996 -
This commit is contained in:
michael 2014-11-05 22:21:55 +00:00
parent 3563944752
commit cbd817b5e8
2 changed files with 83 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -14106,6 +14106,7 @@ tests/webtbs/tw2668.pp svneol=native#text/plain
tests/webtbs/tw2669.pp svneol=native#text/plain
tests/webtbs/tw26749.pp svneol=native#text/pascal
tests/webtbs/tw2676.pp svneol=native#text/plain
tests/webtbs/tw26773.pp svneol=native#text/plain
tests/webtbs/tw2678.pp svneol=native#text/plain
tests/webtbs/tw2690.pp svneol=native#text/plain
tests/webtbs/tw2691.pp svneol=native#text/plain

82
tests/webtbs/tw26773.pp Normal file
View File

@ -0,0 +1,82 @@
program SourceBug;
{$APPTYPE CONSOLE}
{$ifdef FPC}
{$MODE Delphi}
{$endif}
uses
Variants,
SysUtils;
type
TSampleVariant = class(TInvokeableVariantType)
protected
{$ifndef FPC}
function FixupIdent(const AText: string): string; override;
{$endif}
public
procedure Clear(var V: TVarData); override;
procedure Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean ); override;
function GetProperty(var Dest: TVarData; const V: TVarData;
const Name: string): Boolean; override;
function SetProperty(var V: TVarData; const Name: string;
const Value: TVarData): Boolean; override;
end;
procedure TSampleVariant.Clear(var V: TVarData);
begin
V.VType:=varEmpty;
end;
procedure TSampleVariant.Copy(var Dest: TVarData; const Source: TVarData; const Indirect: Boolean);
begin
if Indirect and VarDataIsByRef(Source) then
VarDataCopyNoInd(Dest, Source)
else with Dest do
VType:=Source.VType;
end;
{$ifndef FPC}
function TSampleVariant.FixupIdent(const AText: string): string;
begin
result := AText; // we do not want any uppercase names
end;
{$endif}
function TSampleVariant.GetProperty(var Dest: TVarData; const V: TVarData;
const Name: string): Boolean;
begin
assert(V.VType=varType);
if Name='AnyField' then begin
variant(Dest) := V.VInt64;
result := true;
end else
result := false;
end;
function TSampleVariant.SetProperty(var V: TVarData; const Name: string;
const Value: TVarData): Boolean;
begin
assert(V.VType=varType);
if Name='AnyField' then begin
PVarData(@V)^.VInt64 := variant(Value);
result := true;
end else
result := false;
end;
var
SampleVariant: TSampleVariant;
v: Variant;
begin
SampleVariant:=TSampleVariant.Create;
v := null;
TVarData(v).VType:=SampleVariant.VarType;
v.AnyField := 100;
if v.AnyField=100 then
writeln('ok') else
writeln('ERROR: v.AnyField=',v.AnyField);
readln;
end.