codetools: CheckLFM: improved parinsg objects published as properties

git-svn-id: trunk@10454 -
2025-09-25 13:49:16 +02:00 · 2007-01-16 01:22:58 +00:00 · 2007-01-16 01:22:58 +00:00 · 0657f035a2
commit 0657f035a2
parent fab32e4398
4 changed files with 97 additions and 61 deletions
--- a/components/codetools/codetree.pas
+++ b/components/codetools/codetree.pas
@ -134,6 +134,8 @@ const
      ctnImplementation, ctnInitialization, ctnFinalization];
  AllClassSections =
     [ctnClassPublic,ctnClassPublished,ctnClassPrivate,ctnClassProtected];
+  AllClasses =
+     [ctnClass,ctnClassInterface];
  AllDefinitionSections =
     [ctnTypeSection,ctnVarSection,ctnConstSection,ctnResStrSection,
      ctnLabelSection];
--- a/components/codetools/pascalreadertool.pas
+++ b/components/codetools/pascalreadertool.pas
@ -67,14 +67,15 @@ type

    // properties
    function ExtractPropType(PropNode: TCodeTreeNode;
-        InUpperCase, EmptyIfIndexed: boolean): string;
+                             InUpperCase, EmptyIfIndexed: boolean): string;
    function MoveCursorToPropType(PropNode: TCodeTreeNode): boolean;
    function MoveCursorToPropName(PropNode: TCodeTreeNode): boolean;
    function ExtractPropName(PropNode: TCodeTreeNode;
-        InUpperCase: boolean): string;
+                             InUpperCase: boolean): string;
    function ExtractProperty(PropNode: TCodeTreeNode;
-        Attr: TProcHeadAttributes): string;
+                             Attr: TProcHeadAttributes): string;
    function GetPropertyNameIdentifier(PropNode: TCodeTreeNode): PChar;
+    function GetPropertyTypeIdentifier(PropNode: TCodeTreeNode): PChar;
    function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
    function PropertyNodeHasParamList(PropNode: TCodeTreeNode): boolean;
    function PropNodeIsTypeLess(PropNode: TCodeTreeNode): boolean;
@ -901,6 +902,18 @@ begin
  Result:=@Src[CurPos.StartPos];
 end;

+function TPascalReaderTool.GetPropertyTypeIdentifier(PropNode: TCodeTreeNode
+  ): PChar;
+begin
+
+  // ToDo: ppu, ppw, dcu
+
+  Result:=nil;
+  if PropNode=nil then exit;
+  if not MoveCursorToPropType(PropNode) then exit;
+  Result:=@Src[CurPos.StartPos];
+end;
+
 function TPascalReaderTool.ExtractIdentCharsFromStringConstant(StartPos,
  MinPos, MaxPos, MaxLen: integer): string;
 var
--- a/components/codetools/stdcodetools.pas
+++ b/components/codetools/stdcodetools.pas
@ -1624,9 +1624,11 @@ var
  var
    Params: TFindDeclarationParams;
    IdentifierNotPublished: Boolean;
+    IsPublished: Boolean;
  begin
    Result:=false;
    IdentContext:=CleanFindContext;
+    IsPublished:=false;
    if (ClassContext.Node=nil) or (ClassContext.Node.Desc<>ctnClass) then begin
      DebugLn('TStandardCodeTool.CheckLFM.FindLFMIdentifier Internal error');
      exit;
@ -1639,34 +1641,43 @@ var
      Params.ContextNode:=ClassContext.Node;
      Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
      try
-        if CompareIdentifiers('PopupMenu',PChar(Pointer(IdentName)))=0 then
-        DebugLn('FindLFMIdentifier A ',
+        {DebugLn('FindLFMIdentifier A ',
          ' Ident=',
          '"'+GetIdentifier(Params.Identifier)+'"',
          ' Context="'+ClassContext.Node.DescAsString,'" "',StringToPascalConst(copy(ClassContext.Tool.Src,ClassContext.Node.StartPos,20))+'"',
          ' File="'+ExtractFilename(ClassContext.Tool.MainFilename)+'"',
          ' Flags=['+FindDeclarationFlagsAsString(Params.Flags)+']'
-          );
+          );}
        if ClassContext.Tool.FindIdentifierInContext(Params) then begin
+          Result:=true;
          repeat
            IdentContext:=CreateFindContext(Params);
-        if CompareIdentifiers('PopupMenu',PChar(Pointer(IdentName)))=0 then
-          DebugLn(['FindLFMIdentifier ',FindContextToString(IdentContext)]);
+            if (not IsPublished)
+            and (IdentContext.Node.HasParentOfType(ctnClassPublished)) then
+              IsPublished:=true;
+            
            if (IdentContext.Node<>nil)
            and (IdentContext.Node.Desc=ctnProperty)
            and (IdentContext.Tool.PropNodeIsTypeLess(IdentContext.Node)) then
            begin
              // this is a typeless property -> search further
-              DebugLn(['FindLFMIdentifier property ',FindContextToString(IdentContext),' is typeless searching further ...']);
-              Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
-                             fdfExceptionOnPredefinedIdent,
+              Params.Clear;
+              Params.Flags:=[fdfSearchInAncestors,
                             fdfIgnoreMissingParams,
                             fdfIgnoreCurContextNode,
                             fdfIgnoreOverloadedProcs];
-              Params.ContextNode:=IdentContext.Node;
-              Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
-              if not IdentContext.Tool.FindIdentifierInContext(Params) then
-                break;
+              Params.ContextNode:=IdentContext.Node.Parent;
+              while (Params.ContextNode<>nil)
+              and (not (Params.ContextNode.Desc in AllClasses)) do
+                Params.ContextNode:=Params.ContextNode.Parent;
+              if Params.ContextNode<>nil then begin
+                Params.SetIdentifier(ClassContext.Tool,PChar(Pointer(IdentName)),nil);
+                if not IdentContext.Tool.FindIdentifierInContext(Params) then
+                begin
+                  DebugLn(['FindLFMIdentifier ERROR ancestor of property not found: ',FindContextToString(IdentContext),' IdentName=',IdentName]);
+                  break;
+                end;
+              end;
            end else
              break;
          until false;
@ -1679,15 +1690,7 @@ var
      Params.Free;
    end;

-    IdentifierNotPublished:=false;
-    if (IdentContext.Node<>nil) then begin
-      if (IdentContext.Node.Parent<>nil)
-      and (IdentContext.Node.Parent.Desc<>ctnClassPublished)
-      then
-        IdentifierNotPublished:=true
-      else
-        Result:=true;
-    end;
+    IdentifierNotPublished:=not IsPublished;

    if (IdentContext.Node=nil) or IdentifierNotPublished then begin
      // no proper node found
@ -1725,8 +1728,14 @@ var
    OldInput: TFindDeclarationInput;
  begin
    Result:=CleanFindContext;
+    if (DefinitionNode.Desc=ctnIdentifier) then
+      Identifier:=@StartTool.Src[DefinitionNode.StartPos]
+    else if DefinitionNode.Desc=ctnProperty then
+      Identifier:=StartTool.GetPropertyTypeIdentifier(DefinitionNode)
+    else
+      Identifier:=nil;
+    if Identifier=nil then exit;
    Params:=TFindDeclarationParams.Create;
-    Identifier:=@StartTool.Src[DefinitionNode.StartPos];
    try
      Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound,
        fdfSearchInParentNodes,
@ -1812,6 +1821,7 @@ var
    VariableTypeName: String;
    DefinitionNode: TCodeTreeNode;
    ClassContext: TFindContext;
+    PropertyTypeName: String;
  begin
    // find variable for object
    
@ -1841,48 +1851,57 @@ var
      end;

      // check if identifier is a variable
-      if (ChildContext.Node.Desc <> ctnVarDefinition) then begin
+      if (ChildContext.Node.Desc=ctnVarDefinition) then begin
+        DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(
+                                                             ChildContext.Node);
+        if DefinitionNode=nil then begin
+          ChildContext.Node:=DefinitionNode;
+          LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
+                           LFMObjectName+' is not a variable.'
+                           +CreateFootNote(ChildContext),
+                           LFMObject.NamePosition);
+          exit;
+        end;
+
+        // check if variable has a compatible type
+        if LFMObject.TypeName<>'' then begin
+          VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
+                                                             ChildContext.Node);
+          if (CompareIdentifiers(PChar(VariableTypeName),
+                   PChar(LFMObject.TypeName))<>0)
+          then begin
+            ChildContext.Node:=DefinitionNode;
+            LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
+                           VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
+                           +CreateFootNote(ChildContext),
+                           LFMObject.NamePosition);
+            exit;
+          end;
+        end;
+      end else if (ChildContext.Node.Desc=ctnProperty) then begin
+        // check if variable has a compatible type
+        DefinitionNode:=ChildContext.Node;
+        if LFMObject.TypeName<>'' then begin
+          PropertyTypeName:=
+               ChildContext.Tool.ExtractPropType(ChildContext.Node,false,false);
+          if (CompareIdentifiers(PChar(PropertyTypeName),
+                   PChar(LFMObject.TypeName))<>0)
+          then begin
+            ChildContext.Node:=DefinitionNode;
+            LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
+                           PropertyTypeName+' expected, but '+LFMObject.TypeName+' found.'
+                           +CreateFootNote(ChildContext),
+                           LFMObject.NamePosition);
+            exit;
+          end;
+        end;
+      end else begin
        LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
                         LFMObjectName+' is not a variable'
                         +CreateFootNote(ChildContext),
                         LFMObject.NamePosition);
        exit;
      end;
-      DefinitionNode:=ChildContext.Tool.FindTypeNodeOfDefinition(
-                                                               ChildContext.Node);
-      if DefinitionNode=nil then begin
-        ChildContext.Node:=DefinitionNode;
-        LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
-                         LFMObjectName+' is not a variable.'
-                         +CreateFootNote(ChildContext),
-                         LFMObject.NamePosition);
-        exit;
-      end;
-
-      // check if variable has a compatible type
-      if LFMObject.TypeName<>'' then begin
-        VariableTypeName:=ChildContext.Tool.ExtractDefinitionNodeType(
-                                                               ChildContext.Node);
-        if (CompareIdentifiers(PChar(VariableTypeName),
-                 PChar(LFMObject.TypeName))<>0)
-        then begin
-          ChildContext.Node:=DefinitionNode;
-          LFMTree.AddError(lfmeObjectIncompatible,LFMObject,
-                         VariableTypeName+' expected, but '+LFMObject.TypeName+' found.'
-                         +CreateFootNote(ChildContext),
-                         LFMObject.NamePosition);
-          exit;
-        end;
-      end;
-
-      // check if variable is published
-      if (ChildContext.Node.Parent=nil)
-      or (ChildContext.Node.Parent.Desc<>ctnClassPublished) then begin
-        LFMTree.AddError(lfmeIdentifierNotPublished,LFMObject,
-                         LFMObjectName+' is not published',
-                         LFMObject.NamePosition);
-        exit;
-      end;

      // find class node
      ClassContext:=FindClassNodeForLFMObject(LFMObject,LFMObject.TypeNamePosition,
--- a/ide/idetranslations.pas
+++ b/ide/idetranslations.pas
@ -363,6 +363,7 @@ begin
  Result:=false;
  ContentChanged:=false;
  NewContent:=nil;
+  OldContent:=nil;
  try
    try
      e:=LineEnding;
@ -430,6 +431,7 @@ begin
      Result:=true;
    finally
      NewContent.Free;
+      OldContent.Free;
    end;
  except
    on E: Exception do begin