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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
{$mode delphi}
uses variants, sysutils;
(*$ASSERTIONS ON*)
var
fRefCount: Integer = 0;
type
IA = interface
['{81E19F6A-90C2-11D9-8448-00055DDDEA00}']
end;
TA = class(TObject, IA, IInterface)
destructor Destroy; override;
function _AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
procedure AfterConstruction; override;
class function NewInstance: TObject; override;
end;
class function TA.NewInstance: TObject;
begin
Result := inherited NewInstance;
fRefCount := 1;
end;
procedure TA.AfterConstruction;
begin
InterlockedDecrement(fRefCount);
inherited AfterConstruction;
end;
function TA._AddRef: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
InterlockedIncrement(fRefCount);
Result := 0;
end;
function TA._Release: Integer; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
InterlockedDecrement(fRefCount);
if fRefCount = 0 then begin
Writeln('Destroy');
Self.Destroy;
end;
Result := 0;
end;
function TA.QueryInterface(constref iid: TGuid; out obj): HResult; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
Result := E_NOINTERFACE;
end;
var
gone: Boolean = False;
destructor TA.Destroy;
begin
gone := True;
Writeln('gone');
inherited Destroy;
end;
procedure X;
var
v: Variant;
i: IInterface;
begin
Writeln('start of test');
(* simple test with nil interface *)
i := nil;
v := i;
i := v;
v := 3;
(* complex test with refcounting *)
Writeln('complex test');
i := TA.Create;
assert(fRefCount = 1);
Writeln('part 1');
v := i;
Writeln('part 2');
//assert(fRefCount = 2);
i := nil;
//assert(fRefCount = 1);
Writeln('part 3');
i := v;
//assert(fRefCount = 2);
Writeln('gone false');
assert(gone = False);
i := nil;
//assert(fRefCount = 1);
assert(gone = False);
v := 7; (* TA refcount 0; gone ... note that v := Null doesnt work for some reason *)
//assert(fRefCount = 0);
Writeln('goo');
//assert(gone = True);
(* "gone" *)
Writeln('okay');
//Halt(0);
end;
begin
X;
end.
|
