Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-devel / 2005-12

TPropInfo.SetProc not nil for read-only properties

1 message · 1 person ·

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

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 -

Reply by email