From 35a67fba0406e4add809ccfbd98a24fe833c2e75 Mon Sep 17 00:00:00 2001 From: mattias Date: Thu, 6 Apr 2023 12:33:47 +0200 Subject: [PATCH] codetools: started checking type unitnames --- components/codetools/lfmtrees.pas | 47 ++++++++++-- components/codetools/stdcodetools.pas | 80 +++++++++++++++++---- components/codetools/tests/testlfmtrees.pas | 2 +- 3 files changed, 109 insertions(+), 20 deletions(-) diff --git a/components/codetools/lfmtrees.pas b/components/codetools/lfmtrees.pas index 49d028233a..4078815c7b 100644 --- a/components/codetools/lfmtrees.pas +++ b/components/codetools/lfmtrees.pas @@ -63,7 +63,7 @@ type destructor Destroy; override; procedure Unbind; procedure AddChild(ANode: TLFMTreeNode); - function GetIdentifier: string; + function GetIdentifier: string; virtual; procedure FindIdentifier(out IdentStart, IdentEnd: integer); function GetPath: string; function Next(SkipChildren: Boolean = False): TLFMTreeNode; @@ -89,6 +89,8 @@ type AncestorNode: TObject; // TCodeTreeNode AncestorContextValid: boolean; constructor CreateVirtual; override; + function GetFullName(UnitNameSep: char = '/'; WithName: boolean = true): string; + function GetIdentifier: string; override; end; { TLFMNameParts } @@ -823,7 +825,7 @@ begin while not Parser.TokenSymbolIs('END') do begin if Parser.Token=toEOF then begin Parser.Error('END not found for' - +' object='+ObjectNode.Name+':'+ObjectNode.TypeName + +' object='+ObjectNode.GetFullName +' starting at line '+IntToStr(ObjectStartLine)); end; ProcessObject; @@ -1015,6 +1017,29 @@ end; constructor TLFMObjectNode.CreateVirtual; begin TheType:=lfmnObject; + ChildPos:=-1; +end; + +function TLFMObjectNode.GetFullName(UnitNameSep: char; WithName: boolean + ): string; +begin + Result:=TypeUnitName; + if TypeName<>'' then begin + if Result<>'' then + Result:=Result+UnitNameSep+TypeName + else + Result:=TypeName; + end; + if (not WithName) or (Name='') then exit; + if Result<>'' then + Result:=Name+':'+Result + else + Result:=Name+':MissingLFMType'; +end; + +function TLFMObjectNode.GetIdentifier: string; +begin + Result:=GetFullName; end; { TLFMPropertyNode } @@ -1207,11 +1232,23 @@ begin end; function TLFMError.IsMissingObjectType: boolean; +var + ObjNode: TLFMObjectNode; begin Result:=(ErrorType in [lfmeIdentifierNotFound,lfmeMissingRoot]) - and (Node is TLFMObjectNode) - and (TLFMObjectNode(Node).TypeName<>'') - and (TLFMObjectNode(Node).TypeNamePosition=Position); + and (Node is TLFMObjectNode); + if not Result then exit; + ObjNode:=TLFMObjectNode(Node); + if ObjNode.TypeName='' then + exit(false); + if (Position>=ObjNode.TypeNamePosition) + and (Position'') + and (Position>=ObjNode.TypeUnitNamePosition) + and (Position'' then begin + // type with unitname + // -> search unit + try + Result.Tool:=FindCodeToolForUsedUnit(LFMObject.TypeUnitName,'',true); + except + // ignore search/parse errors + on E: ECodeToolError do ; + end; + if Result.Tool=nil then begin + LFMTree.AddError(lfmeIdentifierNotFound,LFMObject, + 'unit '+LFMObject.TypeUnitName+' not found',LFMObject.TypeUnitNamePosition); + exit; + end; + + // -> search class in unit interface + try + Result.Node:=Result.Tool.FindClassNodeInUnit(aClassName,true,false,true,false); + except + // ignore search/parse errors + on E: ECodeToolError do ; + end; + if (Result.Node=nil) + or (not (Result.Node.Desc in AllClasses)) then begin + Result.Tool:=nil; + LFMTree.AddError(lfmeIdentifierNotFound,LFMObject, + 'type '+aClassName+' not found',LFMObject.TypeNamePosition); + exit; + end; + + exit; + end; + + // type without explicit unitname -> find declaration Params:=TFindDeclarationParams.Create; StartTool:=Self; - Identifier:=PChar(Pointer(ClassName)); + Identifier:=PChar(Pointer(aClassName)); try Params.Flags:=[fdfExceptionOnNotFound, fdfSearchInParentNodes, @@ -2460,13 +2497,17 @@ var Params.Load(OldInput,true); Result:=Params.NewCodeTool.FindBaseTypeOfNode(Params,Params.NewNode); if (Result.Node=nil) - or (not (Result.Node.Desc in AllClasses)) then + or (not (Result.Node.Desc in AllClasses)) then Result:=CleanFindContext; end; except // ignore search/parse errors on E: ECodeToolError do ; end; + if Result.Node=nil then begin + LFMTree.AddError(lfmeIdentifierNotFound,LFMObject, + 'type '+aClassName+' not found',LFMObject.TypeNamePosition); + end; finally Params.Free; end; @@ -2503,7 +2544,7 @@ var begin if ChildContext.Node=nil then begin // this is an extra entry, created via DefineProperties. - // There is no generic way to test such things + // this depends on the runtime class, so codetools cannot check it exit; end; @@ -2541,11 +2582,12 @@ var exit; end; - // ToDo: check if variable/property type exists + if LFMObject.TypeUnitName<>'' then begin + // ToDo: check unitname + end; end; - // find class node //debugln(['CheckLFMChildObject searching class node: LFMObjectName="',LFMObjectName,'" ',FindContextToString(CreateFindContext(ChildContext.Tool,DefinitionNode))]); ClassContext:=FindClassNodeForLFMObject(LFMObject,LFMObject.TypeNamePosition, @@ -2553,12 +2595,8 @@ var //debugln(['CheckLFMChildObject LFMObjectName="',LFMObjectName,'" class context: ',FindContextToString(ClassContext)]); end else begin // try the object type - ClassContext:=FindClassContext(LFMObject.TypeName); - if ClassContext.Node=nil then begin - // object type not found - LFMTree.AddError(lfmeIdentifierNotFound,LFMObject, - 'type '+LFMObject.TypeName+' not found',LFMObject.TypeNamePosition); - end; + ClassContext:=FindClassContext(LFMObject); + if ClassContext.Node=nil then exit; end; // check child LFM nodes if ClassContext.Node<>nil then @@ -2672,7 +2710,7 @@ var function CheckLFMRoot(RootLFMNode: TLFMTreeNode): boolean; var LookupRootLFMNode: TLFMObjectNode; - LookupRootTypeName: String; + LookupRootTypeName, LookupRootTypeUnitName, CurUnitName: String; RootClassNode: TCodeTreeNode; begin Result:=false; @@ -2693,6 +2731,19 @@ var end; // find root type + LookupRootTypeUnitName:=LookupRootLFMNode.TypeUnitName; + if LookupRootTypeUnitName<>'' then begin + CurUnitName:=GetSourceName(false); + if SameText(CurUnitName,LookupRootTypeUnitName) then begin + // unitname fits + end else if RootMustBeClassInIntf or RootMustBeClassInUnit then begin + LFMTree.AddError(lfmeMissingRoot,LookupRootLFMNode, + 'unitname '+LookupRootLFMNode.TypeUnitName+' mismatch', + LookupRootLFMNode.TypeUnitNamePosition); + exit; + end; + end; + if RootMustBeClassInIntf then begin RootClassNode:=FindClassNodeInInterface(LookupRootTypeName,true,false,false); RootContext:=CleanFindContext; @@ -2704,8 +2755,9 @@ var RootContext.Node:=RootClassNode; RootContext.Tool:=Self; end else begin - RootContext:=FindClassContext(LookupRootTypeName); + RootContext:=FindClassContext(LookupRootLFMNode); RootClassNode:=RootContext.Node; + if RootClassNode=nil then exit; end; if RootClassNode=nil then begin LFMTree.AddError(lfmeMissingRoot,LookupRootLFMNode, diff --git a/components/codetools/tests/testlfmtrees.pas b/components/codetools/tests/testlfmtrees.pas index b21be5f04b..f7fc3c8af3 100644 --- a/components/codetools/tests/testlfmtrees.pas +++ b/components/codetools/tests/testlfmtrees.pas @@ -294,7 +294,7 @@ begin AddControls; AddFormUnit(['Button1: TButton']); FLFMCode:=AddSource('unit1.lfm',LinesToStr([ - 'object Form1: Controls/TForm1', + 'object Form1: unit1/TForm1', ' object Button1: Controls/TButton', ' end', 'end'