summaryrefslogtreecommitdiff
path: root/tests/webtbs/tw3101.pp
blob: 4f21f9466a411d668c00c0d0f215c487b187ae31 (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
66
67
68
69
70
71
72
73
74
75
76
77
{ Source provided for Free Pascal Bug Report 3101 }
{ Submitted by "Martin Schreiber" on  2004-05-15 }
{ e-mail:  }

{$ifdef fpc}{$mode objfpc}{$H+}{$endif}

uses
  Classes;

type
 ttestobj = class
  public
   constructor create1;
   constructor create2;
   destructor destroy; override;
   procedure afterconstruction; override;
   procedure beforedestruction; override;
 end;

var
 testobj: ttestobj;
 i : integer;
 err : boolean;

procedure ttestobj.afterconstruction;
begin
 writeln('afterconstruction');
 if i<>3 then
   err:=true;
 inc(i);
end;

procedure ttestobj.beforedestruction;
begin
 writeln('beforedestruction');
 if i<>4 then
   err:=true;
 inc(i);
end;

constructor ttestobj.create1;
begin
 writeln('create1');
 if i<>1 then
   err:=true;
 inc(i);
 self.create2;
end;

constructor ttestobj.create2;
begin
 writeln('create2');
 if i<>2 then
   err:=true;
 inc(i);
end;

destructor ttestobj.destroy;
begin
 writeln('destroy');
 inherited;
 if i<>5 then
   err:=true;
 inc(i);
end;

begin
 i:=1;
 testobj:= ttestobj(ttestobj.newinstance);
 testobj.create1;
 testobj.free;
 //expected: create,afterconstruction,beforedestruction,destroy
 //actual: create,beforedestruction,destroy
 //kylix shows the expected behavior
  if err then
    halt(1);
end.