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
|
{ original: peter5a.pas from the GNU Pascal testsuite }
{ Mac Pascal objects }
{$mode macpas}
program peter5a;
type
Str = String[100];
BaseObject = object
v1: Str;
function m1: Str;
function m2: Str;
end;
SuperObject = object(BaseObject)
v2: Str;
v3: Str;
function m1: Str; override;
function m2: Str; override;
function m3: Str;
end;
var
good: Boolean;
function BaseObject.m1: Str;
begin
return 'BaseObject.' + v1;
end;
function BaseObject.m2: Str;
begin
return 'BaseObject.nov2';
end;
function SuperObject.m1: Str;
begin
return 'SuperObject.' + (inherited m1) + '.' + v1;
end;
function SuperObject.m2: Str;
begin
return 'SuperObject.' + (inherited m2) + '.' + v2;
end;
function SuperObject.m3: Str;
begin
return 'SuperObject.' + v3;
end;
procedure CheckEqual( const param, s1, s2: Str );
begin
if s1 <> s2 then begin
good := false;
WriteLn( 'Failed: ', param, ' = ', s1, ' is not equal to ', s2 );
end;
end;
var
base: BaseObject;
super: SuperObject;
reallysuper: BaseObject;
begin
New(base);
base.v1 := 'basev1';
New(super);
super.v1 := 'superv1';
super.v2 := 'superv2';
super.v3 := 'superv3';
reallysuper := super; { reference copy only! }
good := true;
CheckEqual( 'base.m1', base.m1, 'BaseObject.basev1' );
CheckEqual( 'base.m2', base.m2, 'BaseObject.nov2' );
CheckEqual( 'super.m1', super.m1, 'SuperObject.BaseObject.superv1.superv1' );
CheckEqual( 'super.m2', super.m2, 'SuperObject.BaseObject.nov2.superv2' );
CheckEqual( 'super.m3', super.m3, 'SuperObject.superv3' );
CheckEqual( 'reallysuper.m1', reallysuper.m1, 'SuperObject.BaseObject.superv1.superv1' );
CheckEqual( 'reallysuper.m2', reallysuper.m2, 'SuperObject.BaseObject.nov2.superv2' );
if good then begin
WriteLn( 'OK' );
end
else begin
halt(1);
end;
Dispose( base );
Dispose( super );
end.
|
