blob: 1d02755069c8ece8363cdeac143b07be39829517 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{ Source provided for Free Pascal Bug Report 3899 }
{ Submitted by "Stefan Glienke" on 2005-04-19 }
{ e-mail: glienke@cpa.de }
program project2;
{$mode objfpc}{$H+}
uses
Classes;
type
TZVariant = packed record
VInteger: Int64;
end;
IZInterface = IUnknown;
IZObject = interface(IZInterface)
['{EF46E5F7-00CF-4DDA-BED0-057D6686AEE0}']
function Equals(const Value: IZInterface): Boolean;
end;
IZClonnable = interface(IZObject)
['{ECB7F3A4-7B2E-4130-BA66-54A2D43C0149}']
end;
IZAnyValue = interface (IZClonnable)
['{E81988B3-FD0E-4524-B658-B309B02F0B6A}']
end;
TZAbstractObject = class(TInterfacedObject, IZObject)
public
function Equals(const Value: IZInterface): Boolean; virtual;
end;
TZAnyValue = class(TZAbstractObject, IZAnyValue)
private
FValue: TZVariant;
public
constructor Create(Value: TZVariant);
function Equals(const Value: IZInterface): Boolean; override;
end;
constructor TZAnyValue.Create(Value: TZVariant);
begin
FValue := Value;
end;
function TZAnyValue.Equals(const Value: IZInterface): Boolean;
var
Temp: IZAnyValue;
begin
if Value <> nil then
begin
if Value.QueryInterface(IZAnyValue, Temp) = 0 then
begin
Result := False;
Temp := nil;
end
else
Result := inherited Equals(Value);
end
else
Result := False;
end;
function TZAbstractObject.Equals(const Value: IZInterface): Boolean;
begin
if Value <> nil then
begin
Result := (IZInterface(Self) = Value)
or ((Self as IZInterface) = (Value as IZInterface));
end
else
Result := False;
end;
var
ARecord: TZVariant;
AValue: IZAnyValue;
begin
ARecord.VInteger := 42;
AValue := TZAnyValue.Create(ARecord);
AValue.Equals(AValue);
AValue.Equals(AValue); // <-- this call produces av
end.
|