From 0657f035a2db58c3bd275774044175d30296461c Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 16 Jan 2007 01:22:58 +0000 Subject: [PATCH] codetools: CheckLFM: improved parinsg objects published as properties git-svn-id: trunk@10454 - --- components/codetools/codetree.pas | 2 + components/codetools/pascalreadertool.pas | 19 ++- components/codetools/stdcodetools.pas | 135 ++++++++++++---------- ide/idetranslations.pas | 2 + 4 files changed, 97 insertions(+), 61 deletions(-) diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index fbb04702a7..58cd4c6ed4 100644 --- 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]; diff --git a/components/codetools/pascalreadertool.pas b/components/codetools/pascalreadertool.pas index 5f576ebae6..432802e718 100644 --- 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 diff --git a/components/codetools/stdcodetools.pas b/components/codetools/stdcodetools.pas index ae58724e07..9a68a79d81 100644 --- 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, diff --git a/ide/idetranslations.pas b/ide/idetranslations.pas index 13add9478c..b4e837ffaa 100644 --- 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