[fpc-devel] TPropInfo.SetProc not nil for read-only properties

[Graeme Geldenhuys]

Hi,

The program below shows that the SetProc in not set correctly for 
read-only properties.  Under Delphi this test passes.

See the commented code, for what I must do to get it to work under FPC.

I'm using FPC 2.0.2 on Windows 2000.

---------------------------------------------------------
program Project1;

{$mode objfpc}{$H+}

uses
   Classes, SysUtils, TypInfo;

type
   TTestPropClass = class(TPersistent)
   private
      FIntProp: Integer;
      FReadOnlyIntProp: Integer;
      FReadOnlyStrProp: string;
      FStrProp: string;
   published
     property ReadOnlyStrProp: string read FReadOnlyStrProp;
     property ReadOnlyIntProp: Integer read FReadOnlyIntProp;
     property StrProp: string read FStrProp write FStrProp;
     property IntProp: Integer read FIntProp write FIntProp;
   end;


//------------------------------------------------------------------
function IsReadWriteProp(const pData: TPersistentClass;
   const psPropName: string): boolean;
var
   lPropInfo : PPropInfo ;
begin
   Assert( pData <> nil, 'pData not assigned' ) ;
   Assert( IsPublishedProp( pData, psPropName ), psPropName +
       ' not a published property on ' + pData.ClassName ) ;
   try
     lPropInfo := GetPropInfo( pData, psPropName ) ;
     { This works on FPC only }
//    result    := (lPropInfo^.GetProc <> Pointer($01)) and
//                 (lPropInfo^.SetProc <> Pointer($01));
     { This works on Delphi only }
     result    := ( lPropInfo^.GetProc <> nil ) and
                  ( lPropInfo^.SetProc <> nil ) ;
   except
     on e:exception do
       raise exception.CreateFmt(
         'Error calling IsReadWriteProp with class: %s and property %s',
         [pData.ClassName, psPropName]);
   end;
end;


begin
   if IsReadWriteProp(TTestPropClass, 'ReadOnlyStrProp') then
     Writeln('Failed on 1');
   if IsReadWriteProp(TTestPropClass, 'ReadOnlyIntProp') then
     Writeln('Failed on 2');
   if not IsReadWriteProp(TTestPropClass, 'StrProp') then
     Writeln('Failed on 3');
   if not IsReadWriteProp(TTestPropClass, 'IntProp') then
     Writeln('Failed on 4');
end.

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

Regards,
   - Graeme -