From 5b052ebd3631df06746c87f88fda3aec3f740b64 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 14 Nov 2017 11:01:14 +0000 Subject: [PATCH] codetools: parse attributes git-svn-id: trunk@56402 - --- components/codetools/codetree.pas | 29 +++-- components/codetools/pascalparsertool.pas | 130 +++++++++++++++++++--- 2 files changed, 133 insertions(+), 26 deletions(-) diff --git a/components/codetools/codetree.pas b/components/codetools/codetree.pas index 49976663e3..37b4d8ff9e 100644 --- a/components/codetools/codetree.pas +++ b/components/codetools/codetree.pas @@ -148,9 +148,6 @@ const ctnSpecializeType = 94; // parent = ctnSpecialize ctnSpecializeParams = 95; // list of ctnSpecializeParam, parent = ctnSpecialize ctnSpecializeParam = 96; // parent = ctnSpecializeParams - ctnReferenceTo = 97; // 1st child = ctnProcedureType - ctnConstant = 98; - ctnHintModifier = 99; // deprecated, platform, unimplemented, library, experimental ctnBeginBlock =100; ctnAsmBlock =101; @@ -160,6 +157,13 @@ const ctnOnBlock =112;// childs: ctnOnIdentifier+ctnOnStatement, or ctnVarDefinition(with child ctnIdentifier)+ctnOnStatement ctnOnIdentifier =113;// e.g. 'on Exception', Note: on E:Exception creates a ctnVarDefinition ctnOnStatement =114; + ctnParamsRound =115; + + ctnReferenceTo =120; // 1st child = ctnProcedureType + ctnConstant =121; + ctnHintModifier =122; // deprecated, platform, unimplemented, library, experimental + ctnAttribute =123; // children are ctnAttribParam + ctnAttribParam =124; // 1st child: ctnIdentifier, optional 2nd: ctnParamsRound // combined values AllSourceTypes = @@ -290,6 +294,7 @@ type public Root: TCodeTreeNode; property NodeCount: integer read FNodeCount; + procedure RemoveNode(ANode: TCodeTreeNode); procedure DeleteNode(ANode: TCodeTreeNode); procedure AddNodeAsLastChild(ParentNode, ANode: TCodeTreeNode); procedure AddNodeInFrontOf(NextBrotherNode, ANode: TCodeTreeNode); @@ -464,16 +469,19 @@ begin ctnGenericParams: Result:='Generic Type Params'; ctnGenericParameter: Result:='Generic Type Parameter'; ctnGenericConstraint: Result:='Generic Type Parameter Constraint'; - ctnReferenceTo: Result:='Reference To'; - ctnConstant: Result:='Constant'; - ctnHintModifier: Result:='Hint Modifier'; ctnWithVariable: Result:='With Variable'; ctnWithStatement: Result:='With Statement'; ctnOnBlock: Result:='On Block'; ctnOnIdentifier: Result:='On Identifier'; ctnOnStatement: Result:='On Statement'; + ctnParamsRound: Result:='Params()'; + ctnReferenceTo: Result:='Reference To'; + ctnConstant: Result:='Constant'; + ctnHintModifier: Result:='Hint Modifier'; + ctnAttribute: Result:='Attribute'; + ctnAttribParam: Result:='Attribute Param'; else Result:='invalid descriptor ('+IntToStr(Desc)+')'; end; @@ -941,11 +949,10 @@ begin DeleteNode(Root); end; -procedure TCodeTree.DeleteNode(ANode: TCodeTreeNode); +procedure TCodeTree.RemoveNode(ANode: TCodeTreeNode); begin if ANode=nil then exit; if ANode=Root then Root:=ANode.NextBrother; - while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild); with ANode do begin if (Parent<>nil) then begin if (Parent.FirstChild=ANode) then @@ -960,6 +967,12 @@ begin PriorBrother:=nil; end; dec(FNodeCount); +end; + +procedure TCodeTree.DeleteNode(ANode: TCodeTreeNode); +begin + while (ANode.FirstChild<>nil) do DeleteNode(ANode.FirstChild); + RemoveNode(ANode); ANode.Clear; // clear to spot dangling pointers early ANode.Free; end; diff --git a/components/codetools/pascalparsertool.pas b/components/codetools/pascalparsertool.pas index 31bce8bf4d..0ffe231e69 100644 --- a/components/codetools/pascalparsertool.pas +++ b/components/codetools/pascalparsertool.pas @@ -158,12 +158,14 @@ type function KeyWordFuncResourceString: boolean; function KeyWordFuncExports: boolean; function KeyWordFuncLabel: boolean; - function KeyWordFuncProperty: boolean; + function KeyWordFuncGlobalProperty: boolean; procedure ReadConst; procedure ReadConstExpr; // types procedure ReadTypeNameAndDefinition; procedure ReadGenericParamList(Must: boolean); + procedure ReadAttribute; + procedure FixLastAttributes; procedure ReadTypeReference; procedure ReadClassInterfaceContent; function KeyWordFuncTypeClass: boolean; @@ -235,6 +237,7 @@ type procedure ReadSpecialize(CreateChildNodes: boolean; Extract: boolean = false; Copying: boolean = false; const Attr: TProcHeadAttributes = []); function WordIsPropertyEnd: boolean; + function AllowAttributes: boolean; inline; public CurSection: TCodeTreeNodeDesc; @@ -384,7 +387,7 @@ begin Add('RESOURCESTRING',@KeyWordFuncResourceString); Add('EXPORTS',@KeyWordFuncExports); Add('LABEL',@KeyWordFuncLabel); - Add('PROPERTY',@KeyWordFuncProperty); + Add('PROPERTY',@KeyWordFuncGlobalProperty); Add('GENERIC',@KeyWordFuncProc); Add('PROCEDURE',@KeyWordFuncProc); @@ -473,6 +476,17 @@ begin if StartPos>SrcLen then exit(false); p:=@Src[StartPos]; case UpChars[p^] of + '[': + begin + ReadAttribute; + exit(true); + end; + '(': + begin + ReadTilBracketClose(true); + exit(true); + end; + ';': exit(true); 'C': case UpChars[p[1]] of 'A': if CompareSrcIdentifiers(p,'CASE') then exit(KeyWordFuncTypeRecordCase); @@ -527,12 +541,6 @@ begin then exit(KeyWordFuncClassSection); 'V': if CompareSrcIdentifiers(p,'VAR') then exit(KeyWordFuncClassVarSection); - '(','[': - begin - ReadTilBracketClose(true); - exit(true); - end; - ';': exit(true); end; Result:=KeyWordFuncClassIdentifier; end; @@ -3680,6 +3688,8 @@ begin ReadNextAtom; // name if UpAtomIs('GENERIC') or AtomIsIdentifier then begin ReadTypeNameAndDefinition; + end else if (CurPos.Flag=cafEdgedBracketOpen) and AllowAttributes then begin + ReadAttribute; end else begin UndoReadNextAtom; break; @@ -3687,6 +3697,7 @@ begin until false; CurNode.EndPos:=CurPos.EndPos; EndChildNode; + FixLastAttributes; Result:=true; end; @@ -3743,6 +3754,8 @@ begin end; // read type ReadVariableType; + end else if (CurPos.Flag=cafEdgedBracketOpen) and AllowAttributes then begin + ReadAttribute; end else begin UndoReadNextAtom; break; @@ -3750,6 +3763,7 @@ begin until false; CurNode.EndPos:=CurPos.EndPos; EndChildNode; + FixLastAttributes; Result:=true; end; @@ -3922,7 +3936,7 @@ begin Result:=true; end; -function TPascalParserTool.KeyWordFuncProperty: boolean; +function TPascalParserTool.KeyWordFuncGlobalProperty: boolean; { global properties examples: property @@ -3953,6 +3967,8 @@ begin // close global property CurNode.EndPos:=CurPos.EndPos; EndChildNode; + end else if (CurPos.Flag=cafEdgedBracketOpen) and AllowAttributes then begin + ReadAttribute; end else begin UndoReadNextAtom; break; @@ -3961,6 +3977,7 @@ begin // close property section CurNode.EndPos:=CurPos.EndPos; EndChildNode; + FixLastAttributes; Result:=true; end; @@ -4176,10 +4193,76 @@ begin ReadNextAtom; end; -procedure TPascalParserTool.ReadTypeReference; -{ after reading CurPos is on atom behind the identifier +procedure TPascalParserTool.ReadAttribute; +{ After reading CurPos is on atom ] - examples: + Examples: + [name] + [name,name.name(),name(expr,expr),name(name=expr)] +} +begin + CreateChildNode; + CurNode.Desc:=ctnAttribute; + ReadNextAtom; + repeat + if CurPos.Flag=cafEdgedBracketClose then begin + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; + exit; + end + else if CurPos.Flag=cafWord then begin + CreateChildNode; + CurNode.Desc:=ctnAttribParam; + ReadTypeReference; + if CurPos.Flag=cafRoundBracketOpen then begin + CreateChildNode; + CurNode.Desc:=ctnAttribParam; + ReadTilBracketClose(true); + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; + ReadNextAtom; + end; + CurNode.EndPos:=CurPos.EndPos; + EndChildNode; + end else if CurPos.Flag=cafComma then begin + ReadNextAtom; + end else + SaveRaiseCharExpectedButAtomFound(20171113155128,']'); + until false; +end; + +procedure TPascalParserTool.FixLastAttributes; +{ If CurNode.LastChild.LastChild is ctnAttribute move it to the parent. + +For example: +type + T = char; +[Safe] +[Weak] +procedure DoIt; +} +var + LastSection, Attr, Next: TCodeTreeNode; +begin + LastSection:=CurNode.LastChild; + if LastSection=nil then exit; + if LastSection.LastChild=nil then exit; + Attr:=LastSection.LastChild; + if Attr.Desc<>ctnAttribute then exit; + while (Attr.PriorBrother<>nil) and (Attr.PriorBrother.Desc=ctnAttribute) do + Attr:=Attr.PriorBrother; + repeat + Next:=Attr.NextBrother; + Tree.RemoveNode(Attr); + Tree.AddNodeAsLastChild(CurNode,Attr); + Attr:=Next; + until Attr=nil; +end; + +procedure TPascalParserTool.ReadTypeReference; +{ After reading CurPos is on atom behind the identifier + + Examples: TButton controls.TButton TGenericClass @@ -4227,6 +4310,7 @@ begin // read content ReadNextAtom; if (CurPos.Flag<>cafSemicolon) then begin + // definition, not forward if CurPos.Flag=cafWord then begin if UpAtomIs('EXTERNAL') then begin IsJVM:=Scanner.Values.IsDefined('CPUJVM'); @@ -4257,7 +4341,7 @@ begin CreateChildNode; CurNode.Desc:=ctnClassRequired; end else if IntfDesc=ctnClassInterface then begin - if CurPos.Flag=cafEdgedBracketOpen then + if CurPos.Flag=cafEdgedBracketOpen then ReadGUID; end; if CurPos.Flag<>cafSemicolon then begin @@ -4499,8 +4583,6 @@ begin else CurNode.Desc:=ctnClassPublic; CurNode.StartPos:=LastAtoms.GetValueAt(0).EndPos; - if CurPos.Flag=cafEdgedBracketOpen then - ReadGUID; // parse till "end" of class/object repeat //DebugLn(['TPascalParserTool.KeyWordFuncTypeClass Atom=',GetAtom,' ',CurPos.StartPos>=ClassNode.EndPos]); @@ -5700,14 +5782,21 @@ procedure TPascalParserTool.ReadGUID; SaveRaiseStringExpectedButAtomFound(20170421195909,ctsStringConstant); end; +var + p: Integer; begin + p:=CurPos.StartPos; + ReadNextAtom; + if not AtomIsStringConstant then begin + // not a GUID, an attribute + UndoReadNextAtom; + exit; + end; CreateChildNode; + CurNode.StartPos:=p; CurNode.Desc:=ctnClassGUID; // read GUID ReadNextAtom; - if (not AtomIsStringConstant) and (not AtomIsIdentifier) then - RaiseStringConstantExpected; - ReadNextAtom; if CurPos.Flag<>cafEdgedBracketClose then SaveRaiseCharExpectedButAtomFound(20170421195911,']'); CurNode.EndPos:=CurPos.EndPos; @@ -5891,6 +5980,11 @@ begin Result:=false; end; +function TPascalParserTool.AllowAttributes: boolean; +begin + Result:=Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE,cmOBJFPC]; +end; + procedure TPascalParserTool.ValidateToolDependencies; begin