codetools: FindDanglingComponentEvents: check sub persistents in properties, bug #16831

git-svn-id: trunk@26455 -

components/codetools/codetoolmanager.pas

@@ -672,7 +672,8 @@ type
           const AClassName: string;
           RootComponent: TComponent; ExceptionOnClassNotFound,
           SearchInAncestors: boolean;
-          out ListOfPInstancePropInfo: TFPList): boolean;
+          out ListOfPInstancePropInfo: TFPList;
+          const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
 
     // functions for events in the object inspector
     function GetCompatiblePublishedMethods(Code: TCodeBuffer;
@@ -4691,9 +4692,9 @@ end;
 
 function TCodeToolManager.FindDanglingComponentEvents(Code: TCodeBuffer;
   const AClassName: string; RootComponent: TComponent;
-  ExceptionOnClassNotFound, SearchInAncestors: boolean;
+  ExceptionOnClassNotFound, SearchInAncestors: boolean; out
-  out ListOfPInstancePropInfo: TFPList
+  ListOfPInstancePropInfo: TFPList;
-  ): boolean;
+  const OverrideGetMethodName: TOnGetMethodname): boolean;
 begin
   Result:=false;
   {$IFDEF CTDEBUG}
@@ -4704,7 +4705,7 @@ begin
   try
     Result:=FCurCodeTool.FindDanglingComponentEvents(AClassName,RootComponent,
                               ExceptionOnClassNotFound,SearchInAncestors,
-                              ListOfPInstancePropInfo);
+                              ListOfPInstancePropInfo,OverrideGetMethodName);
   except
     on e: Exception do Result:=HandleException(e);
   end;

components/codetools/codetoolsstructs.pas

@@ -157,6 +157,24 @@ type
     procedure ReplaceString(var s: string);
     function CalcMemSize: PtrUInt;
   end;
+
+type
+  TCTComponentAccess = class(TComponent);
+
+  { TComponentChildCollector }
+
+  TComponentChildCollector = class
+  private
+    FChilds: TFPList;
+    FRoot: TComponent;
+    procedure AddChildComponent(Child: TComponent);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    function GetComponents(RootComponent: TComponent; AddRoot: boolean = true): TFPList;
+    property Childs: TFPList read FChilds;
+    property Root: TComponent read FRoot;
+  end;
   
 function CompareStringToStringItems(Data1, Data2: Pointer): integer;
 function CompareStringAndStringToStringTreeItem(Key, Data: Pointer): integer;
@@ -674,5 +692,45 @@ begin
   end;
 end;
 
+{ TComponentChildCollector }
+
+procedure TComponentChildCollector.AddChildComponent(Child: TComponent);
+var
+  OldRoot: TComponent;
+begin
+  //debugln(['TComponentChildCollector.AddChildComponent ',DbgSName(Child)]);
+  Childs.Add(Child);
+  OldRoot := Root;
+  try
+    if csInline in Child.ComponentState then
+      FRoot := Child;
+    TCTComponentAccess(Child).GetChildren(@AddChildComponent,Root);
+  finally
+    FRoot := OldRoot;
+  end;
+end;
+
+constructor TComponentChildCollector.Create;
+begin
+  FChilds:=TFPList.Create;
+end;
+
+destructor TComponentChildCollector.Destroy;
+begin
+  FreeAndNil(FChilds);
+  inherited Destroy;
+end;
+
+function TComponentChildCollector.GetComponents(RootComponent: TComponent;
+  AddRoot: boolean): TFPList;
+begin
+  Childs.Clear;
+  if AddRoot then
+    Childs.Add(RootComponent);
+  FRoot:=RootComponent;
+  TCTComponentAccess(RootComponent).GetChildren(@AddChildComponent,FRoot);
+  Result:=Childs;
+end;
+
 end.
 

components/codetools/finddeclarationtool.pas

@@ -4274,6 +4274,7 @@ begin
       AVLNode:=PosTree.FindHighest;
       while AVLNode<>nil do begin
         StartPos:=PChar(AVLNode.Data)-PChar(Pointer(Src))+1;
+        // ToDo: if an include file is included twice a code position could be duplicated
         if CleanPosToCaret(StartPos,ReferencePos) then
           AddCodePosition(ListOfPCodeXYPosition,ReferencePos);
         AVLNode:=PosTree.FindPrecessor(AVLNode);

components/codetools/stdcodetools.pas

@@ -192,7 +192,8 @@ type
     function FindDanglingComponentEvents(const TheClassName: string;
           RootComponent: TComponent; ExceptionOnClassNotFound,
           SearchInAncestors: boolean;
-          out ListOfPInstancePropInfo: TFPList): boolean;
+          out ListOfPInstancePropInfo: TFPList;
+          const OverrideGetMethodName: TOnGetMethodname = nil): boolean;
 
     // variables, constants, types
     function RemoveIdentifierDefinition(const CursorPos: TCodeXYPosition;
@@ -4968,8 +4969,9 @@ end;
 
 function TStandardCodeTool.FindDanglingComponentEvents(
   const TheClassName: string; RootComponent: TComponent;
-  ExceptionOnClassNotFound, SearchInAncestors: boolean;
+  ExceptionOnClassNotFound, SearchInAncestors: boolean; out
-  out ListOfPInstancePropInfo: TFPList): boolean;
+  ListOfPInstancePropInfo: TFPList;
+  const OverrideGetMethodName: TOnGetMethodname): boolean;
 var
   PublishedMethods: TAVLTree;
   
@@ -4987,7 +4989,7 @@ var
     {$ENDIF}
   end;
 
-  procedure CheckMethodsInComponent(AComponent: TComponent);
+  procedure CheckMethodsInPersistent(APersistent: TPersistent);
   var
     TypeInfo: PTypeInfo;
     TypeData: PTypeData;
@@ -4997,13 +4999,14 @@ var
     NodeExt: TCodeTreeNodeExtension;
     CurMethod: TMethod;
     CurMethodName: String;
+    ObjValue: TObject;
   begin
-    if AComponent=nil then exit;
+    if APersistent=nil then exit;
     {$IFDEF VerboseDanglingComponentEvents}
-    debugln('TStandardCodeTool.FindDanglingComponentEvents Checking ',DbgSName(AComponent));
+    debugln('TStandardCodeTool.FindDanglingComponentEvents.CheckMethodsInPersistent Checking ',DbgSName(APersistent));
     {$ENDIF}
     // read all properties and remove doubles
-    TypeInfo:=AComponent.ClassInfo;
+    TypeInfo:=APersistent.ClassInfo;
     repeat
       // read all property infos of current class
       TypeData:=GetTypeData(TypeInfo);
@@ -5023,22 +5026,41 @@ var
         debugln('      Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name);
         {$ENDIF}
         PropType:=PropInfo^.PropType;
-        if PropType^.Kind=tkMethod then begin
+
+        if (PropType^.Kind=tkMethod) then begin
           // RTTI property is method
           // -> search method in source
-          CurMethod:=GetMethodProp(AComponent,PropInfo);
+          CurMethod:=GetMethodProp(APersistent,PropInfo);
-          CurMethodName:=OnGetMethodName(CurMethod,RootComponent);
+          if (CurMethod.Data<>nil) or (CurMethod.Code<>nil) then begin
-          {$IFDEF VerboseDanglingComponentEvents}
+            if Assigned(OverrideGetMethodName) then
-          if (CurMethod.Data<>nil) or (CurMethod.COde<>nil) then
+              CurMethodName:=OverrideGetMethodName(CurMethod,RootComponent)
-            debugln('      Component ',DbgSName(AComponent),' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' CurMethodName="',CurMethodName,'"');
+            else
-          {$ENDIF}
+              CurMethodName:=OnGetMethodName(CurMethod,RootComponent);
-          if CurMethodName<>'' then begin
+            {$IFDEF VerboseDanglingComponentEvents}
-            NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName);
+            debugln('      Persistent ',DbgSName(APersistent),' Property ',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' CurMethodName="',CurMethodName,'"');
-            if NodeExt=nil then begin
+            {$ENDIF}
-              // method not found -> dangling event
+            if CurMethodName<>'' then begin
-              AddDanglingEvent(AComponent,PropInfo);
+              NodeExt:=FindCodeTreeNodeExt(PublishedMethods,CurMethodName);
+              if NodeExt=nil then begin
+                // method not found -> dangling event
+                AddDanglingEvent(APersistent,PropInfo);
+              end;
             end;
           end;
+        end else if (PropType^.Kind=tkClass) then begin
+          // RTTI property is class instance
+          ObjValue := TObject(GetObjectProp(APersistent, PropInfo));
+          if ObjValue is TCollection then begin
+            // collection
+
+          end else if (ObjValue is TPersistent)
+          and (not (ObjValue is TComponent)
+               or (csSubComponent in TComponent(ObjValue).ComponentStyle))
+          then begin
+            // sub persistent (e.g. Canvas.Font)
+            //debugln(['CheckMethodsInPersistent sub persistent: ',DbgSName(ObjValue)]);
+            CheckMethodsInPersistent(TPersistent(ObjValue));
+          end;
         end;
         PropInfo:=PPropInfo(pointer(@PropInfo^.Name)+PByte(@PropInfo^.Name)^+1);
         dec(CurCount);
@@ -5049,9 +5071,13 @@ var
 
 var
   i: Integer;
+  Collector: TComponentChildCollector;
+  AllComponents: TFPList;
 begin
   PublishedMethods:=nil;
   ListOfPInstancePropInfo:=nil;
+  Collector:=nil;
+  AllComponents:=nil;
   try
     // search all available published methods
     {$IFDEF VerboseDanglingComponentEvents}
@@ -5062,10 +5088,12 @@ begin
                                          PublishedMethods);
     if not Result then exit;
     // go through all components
-    CheckMethodsInComponent(RootComponent);
+    Collector:=TComponentChildCollector.Create;
-    for i:=0 to RootComponent.ComponentCount-1 do
+    AllComponents:=Collector.GetComponents(RootComponent,true);
-      CheckMethodsInComponent(RootComponent.Components[i]);
+    for i:=0 to AllComponents.Count-1 do
+      CheckMethodsInPersistent(TComponent(AllComponents[i]));
   finally
+    Collector.Free;
     NodeExtMemManager.DisposeAVLTree(PublishedMethods);
   end;
 end;

ide/checklfmdlg.pas

@@ -301,7 +301,8 @@ begin
     // find all dangling events
     //debugln('RemoveDanglingEvents A ',PascalBuffer.Filename,' ',DbgSName(RootComponent));
     if not CodeToolBoss.FindDanglingComponentEvents(PascalBuffer,
-      RootComponent.ClassName,RootComponent,false,true,ListOfPInstancePropInfo)
+      RootComponent.ClassName,RootComponent,false,true,ListOfPInstancePropInfo,
+      @BaseFormEditor1.OnGetDanglingMethodName)
     then begin
       //debugln('RemoveDanglingEvents Errors in code');
       if OkOnCodeErrors then

ide/customformeditor.pp

@@ -155,6 +155,8 @@ type
       var Handled: boolean);
     function SaveUnitComponentToBinStream(AnUnitInfo: TUnitInfo;
       var BinCompStream: TExtMemoryStream): TModalResult;
+    function OnGetDanglingMethodName(const AMethod: TMethod;
+                                     aRootComponent: TObject): string;
 
     // ancestors
     function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override;
@@ -973,6 +975,20 @@ begin
   end;
 end;
 
+function TCustomFormEditor.OnGetDanglingMethodName(const AMethod: TMethod;
+  aRootComponent: TObject): string;
+// check if event is a JITMethod of aRootComponent
+var
+  JITMethod: TJITMethod;
+begin
+  Result:='';
+  if IsJITMethod(aMethod) then begin
+    JITMethod:=TJITMethod(aMethod.Data);
+    if aRootComponent.ClassType=JITMethod.TheClass then
+      Result:=JITMethod.TheMethodName;
+  end;
+end;
+
 function TCustomFormEditor.DesignerCount: integer;
 begin
   Result:=JITFormList.Count+JITNonFormList.Count;