typecast of class reference variable leads to sigsegv
Original Reporter info from Mantis: Pierre @PierreMuller
-
Reporter name: Pierre Muller
Original Reporter info from Mantis: Pierre @PierreMuller
- Reporter name: Pierre Muller
Description:
wen typecasting a class reference variable to a
specific class type, the compiler generates wrong code,
leading to a SIGSEGV.
Steps to reproduce:
{$mode objfpc}
uses
sysutils;
type
TBaseClass = class
constructor Create;
class var x : longint;
var loc : longint;
class procedure check; virtual;
end;
TDerClass = class(TBaseClass)
var der : longint;
end;
TDer1Class = class(TDerClass)
constructor Create;
class var y : longint;
var loc1 : longint;
class procedure check; override;
end;
TDer2Class = class(TDerClass)
constructor Create;
class var z : longint;
var loc2 : longint;
class procedure check; override;
end;
constructor TBaseClass.Create;
begin
Inherited Create;
x:=1;
end;
constructor TDer1Class.Create;
begin
Inherited Create;
y:=1;
end;
constructor TDer2Class.Create;
begin
Inherited Create;
z:=1;
end;
class procedure TBaseClass.check;
begin
writeln('TBaseClass.check called');
end;
class procedure TDer1Class.check;
begin
writeln('TDer1Class.check called');
end;
class procedure TDer2Class.check;
begin
writeln('TDer2Class.check called');
end;
type
TBaseClassRef = class of TBaseClass;
TDerClassRef = class of TDerClass;
var
c : TBaseClass;
cc : TBaseClassRef;
dcc : TDerClassRef;
begin
{$ifndef ERROR_ONLY}
c:=TBaseClass.Create;
inc(c.x);
c.check;
c.free;
c:=TDer1Class.Create;
inc(c.x);
inc(TDer1Class(c).y);
c.check;
c.free;
c:=TDer2Class.Create;
inc(c.x);
inc(TDer2Class(c).z);
c.check;
c.free;
cc:=TbaseClass;
inc(cc.x);
cc.check;
cc:=TDer1Class;
inc(cc.x);
cc.check;
cc:=TDer2Class;
inc(cc.x);
cc.check;
TDerClassRef(cc).check;
TDerClass(cc).check;
dcc:=TDerClass;
dcc.check;
{$else}
cc:=TDer2Class;
{$endif}
try
//inc (TDer1Class(cc).y);
TDer1Class(cc).check;
except
writeln('Exception generated');
end;
writeln('TBaseClass: x=',TBaseClass.x);
writeln('TDer1Class: x=',TDer1Class.x,', y=',TDer1Class.y);
writeln('TDer2Class: x=',TDer2Class.x,', z=',TDer2Class.z);
end.
Additional information:
Tested both in 3.2.0 branch and 3.3.1,
fix ready for trunk.
Mantis conversion info:
- Mantis ID: 34605
- Version: 3.2.0
- Fixed in version: 3.3.1
- Fixed in revision: commit 40377 (#044fae62)