paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-28 15:20:49 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: parse attributes

Browse Source 
git-svn-id: trunk@56402 -
This commit is contained in:
mattias 2017-11-14 11:01:14 +00:00
parent a9808b040a
commit 5b052ebd36
2 changed files with 133 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
components/codetools/codetree.pas
View File

@ -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;

130
components/codetools/pascalparsertool.pas
View File

@ -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<TypeReference,TypeReference>
@ -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