Hi

I have been busy porting a large Delphi app to FP & Lazarus. This issue took me quite a while to find. My RTTI unit tests kept on failing for no obvious reason.

Finally I found the issue. It is a difference between how Delphi and FPC handles Forward Declarations and the {$M+} directive.

I have a workaround for my code, but I'm not sure which compiler handles this correctly and which one doesn't. I did get this info from the Delphi 7 help titled 'Runtime type information': "Note that if a class is forward declared, the first declaration of the class must be declared with the $M switch."

This works under Delphi, but not in FPC. Puting the {$M+} around the forward declaration. You don't get any compiler error in FPC, but calling the GetPropList fuction to retrieve a list of published properties for example will thow an AV example #1

To get this to work in FPC (but then it fails in Delphi) is to put the {$M+} around the actual class declaration and not around the forward declaration. See example #2

Works in Delphi, but not in FPC.
---[Example #1]---------------------------------------
type
{$M+}
   TMyTestObject = class;
{$M-}
   TSomeOtherClass = class(TObject)
   ...
   end;
   TMyTestObject = class(TObject)
   private
      FIntProp: integer;
      FStringProp: string;
   public
   published
     property StringProp: string read FStringProp write FStringProp;
     property IntProp: integer read FIntProp write FIntProp;
   end;
------------------------------------------
Works in FPC, but doesn't in Delphi.
---[Example #2]---------------------------------------
type
   TMyTestObject = class;
   TSomeOtherClass = class(TObject)
   ...
   end;
{$M+}
   TMyTestObject = class(TObject)
   private
      FIntProp: integer;
      FStringProp: string;
   public
   published
     property StringProp: string read FStringProp write FStringProp;
     property IntProp: integer read FIntProp write FIntProp;
   end;
{$M-}
------------------------------------------

Regards,
- Graeme -

Please submit always complete code. Now we need to guess what is wrong and in a lot of cases we can't reproduce it with our own code like in this situation. The code below works perfectly:

{$ifdef fpc}{$mode objfpc}{$endif}
uses
  TypInfo;
type
{$M+}
   TMyTestObject = class;
{$M-}
   TSomeOtherClass = class(TObject)
   end;
type
   TMyTestObject = class(TObject)
   private
      FIntProp: integer;
      FStringProp: string;
   public
   published
     property StringProp: string read FStringProp write FStringProp;
     property IntProp: integer read FIntProp write FIntProp;
   end;
var
  PropList: PPropList;
begin
  writeln(GetPropList(TypeInfo(TMyTestObject),PropList));
end.

Peter Vreman wrote

Please submit always complete code. Now we need to guess what is wrong and in a lot of cases we can't reproduce it with our own code like in this situation. The code below works perfectly:

Sorry about that. Strangely enough, your example runs fine here as well. Below is my complete code that fails. Moving the $M around the actual class declaration makes it work.
I am using FPC 2.0.1 that came with Lazarus 0.9.10 on Windows 2000.

------------------------------------------------
unit Unit1;
{$mode objfpc}{$H+}
interface

uses
Classes, SysUtils, LResources, Forms,
Controls, Graphics, Dialogs, Buttons,

   StdCtrls;

type
{$M+}
   TMyTestObject = class;
{$M-}
   TForm1 = class(TForm)
      Button2: TButton;
      Memo1: TMemo;
      procedure Button2Click(Sender: TObject);
   private
   public
   end;
   TMyTestObject = class(TObject)
   private
      FIntProp: integer;
      FStringProp: string;
   public
   published
     property StringProp: string read FStringProp write FStringProp;
     property IntProp: integer read FIntProp write FIntProp;
   end;
var
   Form1: TForm1;
implementation
uses
   TypInfo;
procedure TForm1.Button2Click(Sender: TObject);
var
   O: TMyTestObject;
   i: Longint;
   lPropFilter: TTypeKinds;
   lCount: Longint;
   lSize: Integer;
   lList: PPropList;
begin
   O := TMyTestObject.Create;
   lPropFilter := [tkInteger, tkAString];
   lCount  := GetPropList(O.ClassInfo, lPropFilter, nil, false);
   lSize   := lCount * SizeOf(Pointer);
   GetMem(lList, lSize);
   memo1.Lines.Add('Total property Count: ' + IntToStr(lCount));
   lCount := GetPropList(O.ClassInfo, lPropFilter, lList, false);
   for i := 0 to lCount-1 do
   begin
     memo1.Lines.Add('Property '+IntToStr(i+1)+': ' + lList^[i]^.Name);
   end;
   FreeMem(lList);
   O.Free;
   memo1.Lines.Add('---------------');
end;
initialization
   {$I unit1.lrs}
end.

------------------------------------------------

Regards,
- Graeme -

Here is the command line version of my app.

------------------------------------------------------
program project1;
{$mode objfpc}{$H+}
uses
   Classes, SysUtils, TypInfo;
type
{$M+}
   TMyTestObject = class;
{$M-}
   TSomeOtherClass = class(TObject)
   private
      FName: string;
   public
     property Name: string read FName write FName;
   end;
   TMyTestObject = class(TObject)
   private
      FIntProp: integer;
      FStringProp: string;
   public
   published
     property StringProp: string read FStringProp write FStringProp;
     property IntProp: integer read FIntProp write FIntProp;
   end;
procedure ShowProperties;
var
   O: TMyTestObject;
   i: Longint;
   lPropFilter: TTypeKinds;
   lCount: Longint;
   lSize: Integer;
   lList: PPropList;
begin
   O := TMyTestObject.Create;
   lPropFilter := [tkInteger, tkAString];
   lCount  := GetPropList(O.ClassInfo, lPropFilter, nil, false);
   lSize   := lCount * SizeOf(Pointer);
   GetMem(lList, lSize);
   Writeln('Total property Count: ' + IntToStr(lCount));
   lCount := GetPropList(O.ClassInfo, lPropFilter, lList, false);
   for i := 0 to lCount-1 do
   begin
     Writeln('Property '+IntToStr(i+1)+': ' + lList^[i]^.Name);
   end;
   FreeMem(lList);
   O.Free;
   Writeln('---------------');
end;
begin
   ShowProperties;
end.

------------------------------------------------------

Regards,
- Graeme -

And this is the error I get:

C:\Programming\Tests\GetPropList\Laz2>project1.exe An unhandled exception occurred at $0043AAEB :
EAccessViolation : Access violation
$0043AAEB GETTYPEDATA, line 478 of ../objpas/typinfo.pp $0043AFF1 GETPROPLIST, line 683 of ../objpas/typinfo.pp $004010BA SHOWPROPERTIES, line 46 of
C:/Programming/Tests/GetPropList/Laz2/p
roject1.pas

Again, running FPC 2.0.1 that came with Lazarus 0.9.10 on Windows 2000.

G.

Here is the command line version of my app. lCount := GetPropList(O.ClassInfo, lPropFilter, nil, false);

Here is the small difference. I used TypeInfo() that returns a direct reference to the RTTI. Your code uses ClassInfo that will load the pointer from the Class structure. The pointer in this class structure is nil.

Fixed

So is this a bug in GetPropList? Why does it work when I move the $M away from the forward declaration to the class declaration?

Regards,
- Graeme -

Peter Vreman wrote

Fixed

Thanks for the quick fixes! In which version of the compile is the fix? 2.1.x or 2.0.x or both? Sorry, I am new to svn and not sure what version to get.

Regards,
- Graeme -

For the moment 2.1.1 only. They will be merge to 2.0.x after they have proven to be save. At least getpropinfos() needs another fix to fix the problem described by Martin.