summaryrefslogtreecommitdiff
path: root/tests/webtbs/tw25607a.pp
blob: 9db91f9d347f5ef47ec549b0d7365240f9fdd411 (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
program E01;

{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$APPTYPE CONSOLE}

type
  TA = class
    constructor Create(A: Integer = 0); overload; virtual;
  end;

  TB = class(TA)
    constructor Create(A: Integer); overload; override;
  end;

  TClassB = class of TB;

var
  tacalled,
  tbcalled: boolean;

constructor TA.Create(A: Integer = 0);
begin
  WriteLn('TA.Create');
  tacalled:=true;
end;

constructor TB.Create(A: Integer);
begin
  WriteLn('TB.Create');
  tbcalled:=true;
end;

var
  B: TB;
  ClassB: TClassB;
begin
  B := TB.Create; // TA.Create (VMT is not used
                  // compiler can determine) -- in Delphi;
                  // In FPC, because TB.Create is used, we
                  // call TB.Create
  if tacalled then
    halt(1);
  if not tbcalled then
    halt(2);
  tbcalled:=false;

  B.Create; // call TB.Create because of VMT rules
  B.Free;
  if tacalled then
    halt(3);
  if not tbcalled then
    halt(4);
  tbcalled:=false;

  ClassB := TB;
  B := ClassB.Create; // call TB.Create because of VMT rules
  B.Free;
  if tacalled then
    halt(5);
  if not tbcalled then
    halt(6);
end.