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 -
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
