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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
|
{ Old file: tbs0312.pp }
{ Again the problem of local procs inside methods }
{ Program that showss a problem if
Self is not reloaded in %esi register
at entry in local procedure inside method }
uses
objects;
type
{$ifndef FPC}
sw_integer = integer;
{$endif not FPC}
PMYObj = ^TMyObj;
TMyObj = Object(TObject)
x : longint;
Constructor Init(ax : longint);
procedure display;virtual;
end;
PMYObj2 = ^TMyObj2;
TMyObj2 = Object(TMyObj)
y : longint;
Constructor Init(ax,ay : longint);
procedure display;virtual;
end;
PMyCollection = ^TMyCollection;
TMyCollection = Object(TCollection)
function At(I : sw_integer) : PMyObj;
procedure DummyThatShouldNotBeCalled;virtual;
end;
{ TMy is also a TCollection so that
ShowMy and DummyThatShouldNotBeCalled are at same position in VMT }
TMy = Object(TCollection)
Col : PMyCollection;
MyObj : PMyObj;
ShowMyCalled : boolean;
constructor Init;
destructor Done;virtual;
procedure ShowAll;
procedure AddMyObj(x : longint);
procedure AddMyObj2(x,y : longint);
procedure ShowMy;virtual;
end;
Constructor TMyObj.Init(ax : longint);
begin
Inherited Init;
x:=ax;
end;
Procedure TMyObj.Display;
begin
Writeln('x = ',x);
end;
Constructor TMyObj2.Init(ax,ay : longint);
begin
Inherited Init(ax);
y:=ay;
end;
Procedure TMyObj2.Display;
begin
Writeln('x = ',x,' y = ',y);
end;
Function TMyCollection.At(I : sw_integer) : PMyObj;
begin
At:=Inherited At(I);
end;
Procedure TMyCollection.DummyThatShouldNotBeCalled;
begin
Writeln('This method should never be called');
Abstract;
end;
Constructor TMy.Init;
begin
New(Col,Init(5,5));
MyObj:=nil;
ShowMyCalled:=false;
end;
Destructor TMy.Done;
begin
Dispose(Col,Done);
Inherited Done;
end;
Procedure TMy.ShowAll;
procedure ShowIt(P : pointer);{$ifdef TP}far;{$endif}
begin
ShowMy;
PMyObj(P)^.Display;
end;
begin
Col^.ForEach(@ShowIt);
end;
Procedure TMy.ShowMy;
begin
if assigned(MyObj) then
MyObj^.Display;
ShowMyCalled:=true;
end;
Procedure TMy.AddMyObj(x : longint);
begin
MyObj:=New(PMyObj,Init(x));
Col^.Insert(MyObj);
end;
Procedure TMy.AddMyObj2(x,y : longint);
begin
MyObj:=New(PMyObj2,Init(x,y));
Col^.Insert(MyObj);
end;
var
My : TMy;
begin
My.Init;
My.AddMyObj(5);
My.AddMyObj2(4,3);
My.AddMyObj(43);
{ MyObj field is now a PMyObj with value 43 }
My.ShowAll;
If not My.ShowMyCalled then
begin
Writeln('ShowAll does not work correctly');
Halt(1);
end;
My.Done;
end.
|
