paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 13:39:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: parse class helper

Browse Source 
git-svn-id: trunk@35047 -
This commit is contained in:
mattias 2012-01-31 02:25:25 +00:00
parent 50053c20cd
commit ec66ae883a
2 changed files with 43 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/codetools/codetree.pas
View File

@ -95,17 +95,19 @@ const
ctnClassAbstract = 40;
ctnClassSealed = 41;
ctnClassExternal = 42;
ctnClassInheritance = 43;
ctnClassGUID = 44;
ctnClassClassVar = 45; // child of visibility section
ctnClassPrivate = 46; // child of AllClassObjects
ctnClassProtected = 47;
ctnClassPublic = 48;
ctnClassPublished = 49;
ctnClassRequired = 50;
ctnClassOptional = 51;
ctnProperty = 52; // child of visibility section or AllClassInterfaces
ctnMethodMap = 53; // child of visibility section or AllClassInterfaces
ctnClassHelper = 43;
ctnClassInheritance = 44;
ctnClassHelperFor = 45;
ctnClassGUID = 46;
ctnClassClassVar = 47; // child of visibility section
ctnClassPrivate = 48; // child of AllClassObjects
ctnClassProtected = 49;
ctnClassPublic = 50;
ctnClassPublished = 51;
ctnClassRequired = 52;
ctnClassOptional = 53;
ctnProperty = 54; // child of visibility section or AllClassInterfaces
ctnMethodMap = 55; // child of visibility section or AllClassInterfaces
ctnProcedure = 60; // children: ctnProcedureHead, sections, ctnBeginBlock/ctnAsmBlock
ctnProcedureHead = 61; // children: ctnParameterList, operator: ctnVarDefinition, operator/function: ctnIdentifier
@ -371,6 +373,8 @@ begin
ctnClassAbstract: Result:='abstract';
ctnClassSealed: Result:='sealed';
ctnClassExternal: Result:='external';
ctnClassHelper: Result:='helper';
ctnClassHelperFor: Result:='(helper) for';
ctnProcedure: Result:='Procedure';
ctnProcedureHead: Result:='ProcedureHead';

29
components/codetools/pascalparsertool.pas
View File

@ -3851,6 +3851,7 @@ var
IsForward: Boolean;
ClassDesc: TCodeTreeNodeDesc;
ClassNode: TCodeTreeNode;
IsHelper: Boolean;
begin
//debugln(['TPascalParserTool.KeyWordFuncTypeClass ',GetAtom,' ',CleanPosToStr(CurPos.StartPos)]);
// class or 'class of' start found
@ -3887,8 +3888,10 @@ begin
CurNode.Desc:=ClassDesc;
CurNode.StartPos:=ClassAtomPos.StartPos;
IsForward:=true;
IsHelper:=false;
ReadNextAtom;
if (ClassDesc=ctnClass) and UpAtomIs('OF') then begin
// class of
IsForward:=false;
CurNode.Desc:=ctnClassOfType;
ReadNextAtom;
@ -3936,6 +3939,13 @@ begin
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
end;
end else if UpAtomIs('HELPER') then begin
IsHelper:=true;
CreateChildNode;
CurNode.Desc:=ctnClassHelper;
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
ReadNextAtom;
end;
end;
if (CurPos.Flag=cafRoundBracketOpen) then begin
@ -3944,6 +3954,19 @@ begin
ReadClassInheritance(true);
ReadNextAtom;
end;
if IsHelper then begin
if not UpAtomIs('FOR') then
RaiseStringExpectedButAtomFound('for');
CreateChildNode;
CurNode.Desc:=ctnClassHelperFor;
repeat
ReadNextAtom;
AtomIsIdentifier(true);
CurNode.EndPos:=CurPos.EndPos;
ReadNextAtom;
until CurPos.Flag<>cafPoint;
EndChildNode;
end;
end;
if CurPos.Flag=cafSemicolon then begin
if (ClassDesc in AllClassObjects) then
@ -4647,8 +4670,12 @@ begin
end;
procedure TPascalParserTool.RaiseCharExpectedButAtomFound(c: char);
var
a: String;
begin
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[c,GetAtom]);
a:=GetAtom;
if a='' then a:=ctsEndOfFile;
SaveRaiseExceptionFmt(ctsStrExpectedButAtomFound,[c,a]);
end;
procedure TPascalParserTool.RaiseStringExpectedButAtomFound(const s: string);