freepascal.compiler/tests/test/cg/tobjsize.pp

{$static on}

type
   pbaseclass = ^tbaseclass;
   pderivedclass = ^tderivedclass;

   tbaseclass = object
     x : longint;
     constructor init;
     function getsize : longint; static;
     function getsize2 : longint;
     procedure check_size; virtual;
     procedure static_check_size; static;
     procedure check_normal;
     procedure check_static; static;
     procedure check_virtual; virtual;
     destructor done; virtual;
   end;

   tderivedclass = object(tbaseclass)
     y : longint;
     procedure check_size; virtual;
   end;

const
  has_error : boolean = false;
  expected_size_for_tbaseclass = sizeof(pointer) + sizeof(longint);
  expected_size_for_tderivedclass = sizeof(pointer) + 2*sizeof(longint);

var
  basesize : longint;
  derivedsize : longint;

constructor tbaseclass.init;
begin
end;

destructor tbaseclass.done;
begin
end;

function tbaseclass.getsize : longint;
begin
  getsize:=sizeof(self);
end;

function tbaseclass.getsize2 : longint;
begin
  getsize2:=sizeof(self);
end;

procedure tbaseclass.check_size;
begin
  if sizeof(self)<>getsize then
    begin
      Writeln('Compiler creates garbage');
      has_error:=true;
    end;
  if sizeof(self)<>getsize2 then
    begin
      Writeln('Compiler creates garbage');
      has_error:=true;
    end;
end;

procedure tbaseclass.static_check_size;
begin
  if sizeof(self)<>getsize then
    begin
      Writeln('Compiler creates garbage');
      has_error:=true;
    end;
end;

procedure tbaseclass.check_normal;
begin
  check_size;
  static_check_size;
end;

procedure tbaseclass.check_static;
begin
  {check_size;}
  static_check_size;
end;

procedure tbaseclass.check_virtual;
begin
  check_size;
  static_check_size;
end;


procedure tderivedclass.check_size;

begin
  Writeln('Calling tderived check_size method');
  inherited check_size;
end;

var
  cb : tbaseclass;
  cd : tderivedclass;
  c1 : pbaseclass;
begin
 cb.init;
 cd.init;
 new(c1,init);

 basesize:=sizeof(cb);
 Writeln('Sizeof(cb)=',basesize);
 if basesize<>expected_size_for_tbaseclass then
   Writeln('not the expected size : ',expected_size_for_tbaseclass);

 derivedsize:=sizeof(cd);
 Writeln('Sizeof(ct)=',derivedsize);
 if derivedsize<>expected_size_for_tderivedclass then
   Writeln('not the expected size : ',expected_size_for_tderivedclass);

 cb.check_size;
 cd.check_size;
 c1^.check_size;
 cb.static_check_size;
 cd.static_check_size;
 c1^.static_check_size;
 tbaseclass.static_check_size;
 tderivedclass.static_check_size;
 tbaseclass.check_static;
 tderivedclass.check_static;

 cb.check_normal;
 cb.check_static;
 cb.check_virtual;
 cd.check_normal;
 cd.check_static;
 cd.check_virtual;

 dispose (c1,done);

 c1:=new(pderivedclass,init);
 c1^.check_size;
 c1^.static_check_size;
 dispose (c1,done);

 if has_error then
   begin
     Writeln('Error with class methods');
     halt(1);
   end;

end.