blob: e5f37316775046ee7881c0d9ff3cefbd5a7e61fd (
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
|
{****************************************************************}
{ CODE GENERATOR TEST PROGRAM }
{ By Carl Eric Codere }
{****************************************************************}
{ NODE TESTED : secondloadvmt() }
{****************************************************************}
{ DEFINES: }
{ FPC = Target is FreePascal compiler }
{****************************************************************}
{ REMARKS : Tested with Delphi 3 as reference implementation }
{****************************************************************}
program tloadvmt;
{$ifdef fpc}
{$mode objfpc}
{$endif}
const
RESULT_STRING = 'Hello world';
Type
TAObject = class(TObject)
a : longint;
end;
TBObject = Class(TAObject)
b : longint;
s : shortstring;
constructor create(c: longint);
function getstring : shortstring;
end;
procedure fail;
begin
WriteLn('Failure.');
halt(1);
end;
constructor tbobject.create(c:longint);
begin
taobject.create;
b:=c;
s:=RESULT_STRING;
end;
function tbobject.getstring : shortstring;
begin
getstring := s;
end;
var
bobj: TBobject;
i: integer;
l : longint;
Begin
i:=$7f;
Write('Secondloadvmt test...');
bobj:=TBobject.create(i);
if bobj.getstring <> RESULT_STRING then
fail
else
WriteLn('Success!');
end.
|
