paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 19:29:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: useanalyzer: fixed typeinfo of inherited property

Browse Source 
git-svn-id: trunk@38991 -
This commit is contained in:
Mattias Gaertner 2018-05-14 16:54:28 +00:00
parent 67446aa414
commit af1e46ac6c
3 changed files with 36 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -781,7 +781,7 @@ procedure TPasAnalyzer.UseTypeInfo(El: TPasElement);
var
C: TClass;
Members: TFPList;
Members, Args: TFPList;
i: Integer;
Member: TPasElement;
MemberResolved: TPasResolverResult;
@ -804,15 +804,16 @@ begin
begin
// published property
Prop:=TPasProperty(El);
for i:=0 to Prop.Args.Count-1 do
UseSubEl(TPasArgument(Prop.Args[i]).ArgType);
UseSubEl(Prop.VarType);
Args:=Resolver.GetPasPropertyArgs(Prop);
for i:=0 to Args.Count-1 do
UseSubEl(TPasArgument(Args[i]).ArgType);
UseSubEl(Resolver.GetPasPropertyType(Prop));
UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false);
UseElement(Resolver.GetPasPropertySetter(Prop),rraRead,false);
UseElement(Resolver.GetPasPropertyIndex(Prop),rraRead,false);
// stored and defaultvalue are only used when published -> mark as used
UseElement(Resolver.GetPasPropertyStoredExpr(Prop),rraRead,false);
UseElement(Prop.DefaultExpr,rraRead,false);
UseElement(Resolver.GetPasPropertyDefaultExpr(Prop),rraRead,false);
end
else if (C=TPasAliasType) or (C=TPasTypeAliasType) then
UseSubEl(TPasAliasType(El).DestType)
@ -1707,6 +1708,7 @@ begin
// when checking a single unit, mark all method+properties implementing the interfaces
MarkAllInterfaceImplementations(ClassScope);
end;
// members
AllPublished:=(Mode<>paumAllExports);
for i:=0 to El.Members.Count-1 do

2
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -7888,7 +7888,7 @@ begin
'begin',
' TObject.Create;']);
ParseProgram;
CheckResolverHint(mtNote,nConstructingClassXWithAbstractMethodY,'Constructing a class "TObject" with abstract method "DoIt"');
CheckResolverHint(mtWarning,nConstructingClassXWithAbstractMethodY,'Constructing a class "TObject" with abstract method "DoIt"');
CheckResolverUnexpectedHints;
end;

28
packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

@ -145,6 +145,7 @@ type
procedure TestWP_PublishedProperty;
procedure TestWP_BuiltInFunctions;
procedure TestWP_TypeInfo;
procedure TestWP_TypeInfo_PropertyEnumType;
procedure TestWP_ForInClass;
procedure TestWP_AssertSysUtils;
procedure TestWP_RangeErrorSysUtils;
@ -2467,6 +2468,33 @@ begin
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_TypeInfo_PropertyEnumType;
begin
StartProgram(false);
Add([
'type',
' TObject = class end;',
' {#talign_typeinfo}TAlign = (alLeft,alRight);',
' {$M+}',
' TPersistent = class',
' private',
' FAlign: TAlign;',
' public',
' property {#tpersistent_align_notypeinfo}Align: TAlign read FAlign write FAlign;',
' end;',
' {$M-}',
' {#tbutton_typeinfo}TButton = class(TPersistent)',
' published',
' property {#tbutton_align_typeinfo}Align;',
' end;',
'var',
' {#p_notypeinfo}p: pointer;',
'begin',
' p:=typeinfo(TButton);',
'']);
AnalyzeWholeProgram;
end;
procedure TTestUseAnalyzer.TestWP_ForInClass;
begin
StartProgram(false);