paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-19 04:02:11 +02:00
Code Issues Packages Projects Releases Wiki Activity

IdeIntf: Prevent a recursive loop in IsInteresting, IsPropInClass function. Issue #29921.

Browse Source 
git-svn-id: trunk@52128 -
This commit is contained in:
juha 2016-04-06 22:15:56 +00:00
parent f30c4db48e
commit a1f09debb2
1 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/ideintf/propedits.pp
View File

@ -6860,6 +6860,9 @@ function IsInteresting(AEditor: TPropertyEditor; const AFilter: TTypeKinds;
var
visited: TFPList;
UpperPropName: String;
// RecurseLevel counter is a hack to prevent a recursive loop in IsPropInClass.
// ToDo: Fix the fundamental reason for recursive loop.
ClassRecurseLevel: integer;
// check set element names against AFilter
function IsPropInSet( const ATypeInfo: PTypeInfo ) : Boolean;
@ -6893,6 +6896,9 @@ var
propList: PPropList;
i, propCount: Integer;
begin
if ClassRecurseLevel > 10 then
DebugLn(['IsInteresting,IsPropInClass: ClassRecurseLevel=', ClassRecurseLevel]);
Inc(ClassRecurseLevel);
Result := False;
propCount := GetPropList(ATypeInfo, propList);
for i := 0 to propCount - 1 do
@ -6905,12 +6911,11 @@ var
if Result then break;
end;
// check properties of subclass recursively
if (propInfo^.PropType^.Kind = tkClass) then
if (propInfo^.PropType^.Kind = tkClass) and (ClassRecurseLevel < 15) then
begin
Result := IsPropInClass( propInfo^.PropType );
if Result then break;
end;
Result := ContainsTextUpper( propInfo^.Name, UpperPropName );
if result then break;
end;
@ -6963,8 +6968,11 @@ var
// if no SubProperties check against filter name
if (UpperPropName <> '') then
if (paSubProperties in A.GetAttributes) then
begin
ClassRecurseLevel := 0;
Result := ContainsTextUpper(A.GetName, UpperPropName)
or IsPropInClass(A.GetPropType)
end
else
Result := ContainsTextUpper(A.GetName, UpperPropName );