View Issue Details

IDProjectCategoryView StatusLast Update
0034605FPCCompilerpublic2018-12-01 16:42
ReporterPierre MullerAssigned ToPierre Muller 
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
Product Version3.2.0Product Build 
Target VersionFixed in Version3.3.1 
Summary0034605: typecast of class reference variable leads to sigsegv
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.
TagsNo tags attached.
Fixed in Revisioncommit 40377
FPCOldBugId0
FPCTarget
Attached Files

Activities

Pierre Muller

2018-12-01 16:42

developer   ~0112298

Should be fixed with commit #40377:

https://svn.freepascal.org/cgi-bin/viewvc.cgi?view=revision&sortby=date&revision=40377

The test only fails on compilatino for some msdos testsuites,
but this is due to _TEXT segment size overflow,
and not related directly to the code of the test.

Issue History

Date Modified Username Field Change
2018-11-25 22:34 Pierre Muller New Issue
2018-12-01 16:42 Pierre Muller Fixed in Revision => commit 40377
2018-12-01 16:42 Pierre Muller Note Added: 0112298
2018-12-01 16:42 Pierre Muller Status new => resolved
2018-12-01 16:42 Pierre Muller Fixed in Version => 3.3.1
2018-12-01 16:42 Pierre Muller Resolution open => fixed
2018-12-01 16:42 Pierre Muller Assigned To => Pierre Muller