mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-01 13:22:37 +02:00
52 lines
644 B
ObjectPascal
52 lines
644 B
ObjectPascal
{ %wpoparas=devirtcalls,optvmts }
|
|
{ %wpopasses=1 }
|
|
|
|
{$mode objfpc}
|
|
{$m+}
|
|
|
|
{ check that multiple descendents properly mark parent class method as
|
|
non-optimisable
|
|
}
|
|
|
|
type
|
|
tbase = class
|
|
procedure test; virtual;
|
|
end;
|
|
|
|
tchild1 = class(tbase)
|
|
procedure test; override;
|
|
end;
|
|
|
|
tchild2 = class(tbase)
|
|
published
|
|
procedure test; override;
|
|
end;
|
|
|
|
procedure tbase.test;
|
|
begin
|
|
halt(1);
|
|
end;
|
|
|
|
var
|
|
a: longint;
|
|
|
|
procedure tchild1.test;
|
|
begin
|
|
if a<>1 then
|
|
halt(2);
|
|
end;
|
|
|
|
procedure tchild2.test;
|
|
begin
|
|
if a<>2 then
|
|
halt(3);
|
|
end;
|
|
|
|
var
|
|
bb: tbase;
|
|
begin
|
|
bb:=tchild1.create;
|
|
if (bb is tchild2) then
|
|
halt(1);
|
|
end.
|