mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-06 15:00:31 +02:00
MG: find declaration of class ancestor, result type, default property, array, indexed pointer
git-svn-id: trunk@602 -
This commit is contained in:
parent
eb66cd1363
commit
147fbd54ee
@ -52,55 +52,56 @@ const
|
||||
// CodeTreeNodeDescriptors
|
||||
ctnNone = 0;
|
||||
|
||||
ctnClass = 1;
|
||||
ctnClassPublished = 2;
|
||||
ctnClassPrivate = 3;
|
||||
ctnClassProtected = 4;
|
||||
ctnClassPublic = 5;
|
||||
ctnProgram = 1;
|
||||
ctnPackage = 2;
|
||||
ctnLibrary = 3;
|
||||
ctnUnit = 4;
|
||||
ctnInterface = 5;
|
||||
ctnImplementation = 6;
|
||||
ctnInitialization = 7;
|
||||
ctnFinalization = 8;
|
||||
|
||||
ctnProcedure = 10;
|
||||
ctnProcedureHead = 11;
|
||||
ctnParameterList = 12;
|
||||
ctnTypeSection = 10;
|
||||
ctnVarSection = 11;
|
||||
ctnConstSection = 12;
|
||||
ctnResStrSection = 13;
|
||||
ctnUsesSection = 14;
|
||||
|
||||
ctnBeginBlock = 20;
|
||||
ctnAsmBlock = 21;
|
||||
ctnTypeDefinition = 20;
|
||||
ctnVarDefinition = 21;
|
||||
ctnConstDefinition = 22;
|
||||
|
||||
ctnProgram = 30;
|
||||
ctnPackage = 31;
|
||||
ctnLibrary = 32;
|
||||
ctnUnit = 33;
|
||||
ctnInterface = 34;
|
||||
ctnImplementation = 35;
|
||||
ctnInitialization = 36;
|
||||
ctnFinalization = 37;
|
||||
ctnClass = 30;
|
||||
ctnClassPublished = 31;
|
||||
ctnClassPrivate = 32;
|
||||
ctnClassProtected = 33;
|
||||
ctnClassPublic = 34;
|
||||
|
||||
ctnTypeSection = 40;
|
||||
ctnVarSection = 41;
|
||||
ctnConstSection = 42;
|
||||
ctnResStrSection = 43;
|
||||
ctnUsesSection = 44;
|
||||
|
||||
ctnTypeDefinition = 50;
|
||||
ctnVarDefinition = 51;
|
||||
ctnConstDefinition = 52;
|
||||
|
||||
ctnProperty = 60;
|
||||
ctnProperty = 40;
|
||||
|
||||
ctnIdentifier = 70;
|
||||
ctnArrayType = 71;
|
||||
ctnRecordType = 72;
|
||||
ctnRecordCase = 73;
|
||||
ctnRecordVariant = 74;
|
||||
ctnProcedureType = 75;
|
||||
ctnSetType = 76;
|
||||
ctnRangeType = 77;
|
||||
ctnEnumType = 78;
|
||||
ctnLabelType = 79;
|
||||
ctnTypeType = 80;
|
||||
ctnFileType = 81;
|
||||
ctnPointerType = 82;
|
||||
ctnClassOfType = 83;
|
||||
ctnProcedure = 50;
|
||||
ctnProcedureHead = 51;
|
||||
ctnParameterList = 52;
|
||||
|
||||
ctnIdentifier = 60;
|
||||
ctnArrayType = 61;
|
||||
ctnOfConstType = 62;
|
||||
ctnRecordType = 63;
|
||||
ctnRecordCase = 64;
|
||||
ctnRecordVariant = 65;
|
||||
ctnProcedureType = 66;
|
||||
ctnSetType = 67;
|
||||
ctnRangeType = 68;
|
||||
ctnEnumType = 69;
|
||||
ctnLabelType = 70;
|
||||
ctnTypeType = 71;
|
||||
ctnFileType = 72;
|
||||
ctnPointerType = 73;
|
||||
ctnClassOfType = 74;
|
||||
|
||||
ctnBeginBlock = 80;
|
||||
ctnAsmBlock = 81;
|
||||
|
||||
ctnWithVariable = 90;
|
||||
ctnWithStatement = 91;
|
||||
|
||||
@ -123,8 +124,9 @@ const
|
||||
|
||||
|
||||
// CodeTreeNodeSubDescriptors
|
||||
ctnsNone = 0;
|
||||
ctnsForwardDeclaration = 1;
|
||||
ctnsNone = 0;
|
||||
ctnsForwardDeclaration = 1;
|
||||
ctnsProcHeadNodesCreated = 2;
|
||||
|
||||
type
|
||||
TCodeTreeNode = class
|
||||
@ -548,7 +550,7 @@ begin
|
||||
FCount:=0;
|
||||
FAllocatedNodes:=0;
|
||||
FFreedNodes:=0;
|
||||
FMinFree:=10000;
|
||||
FMinFree:=100000;
|
||||
FMaxFreeRatio:=8; // 1:1
|
||||
end;
|
||||
|
||||
@ -626,7 +628,7 @@ begin
|
||||
FFirstFree:=nil;
|
||||
FFreeCount:=0;
|
||||
FCount:=0;
|
||||
FMinFree:=10000;
|
||||
FMinFree:=20000;
|
||||
FMaxFreeRatio:=8; // 1:1
|
||||
end;
|
||||
|
||||
|
@ -224,6 +224,10 @@ begin
|
||||
// CodeTreeNodeSubDescriptors
|
||||
ctnsForwardDeclaration : Result:='Forward';
|
||||
end;
|
||||
ctnProcedureHead:
|
||||
case SubDesc of
|
||||
ctnsProcHeadNodesCreated: Result:='Nodes Created';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -596,13 +596,21 @@ if (ContextNode.Desc=ctnClass) then
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublic, ctnClassPrivate, ctnClassProtected, ctnClassPublished,
|
||||
ctnClass,
|
||||
ctnRecordType, ctnRecordCase, ctnRecordVariant:
|
||||
ctnRecordType, ctnRecordCase, ctnRecordVariant,
|
||||
ctnParameterList:
|
||||
if (ContextNode.LastChild<>nil) then begin
|
||||
if not (fdfSearchForward in Params.Flags) then
|
||||
ContextNode:=ContextNode.LastChild
|
||||
else
|
||||
ContextNode:=ContextNode.FirstChild;
|
||||
end;
|
||||
|
||||
ctnProcedureHead:
|
||||
begin
|
||||
BuildSubTreeForProcHead(ContextNode);
|
||||
if ContextNode.FirstChild<>nil then
|
||||
ContextNode:=ContextNode.FirstChild;
|
||||
end;
|
||||
|
||||
ctnTypeDefinition, ctnVarDefinition, ctnConstDefinition, ctnEnumType:
|
||||
begin
|
||||
@ -645,15 +653,21 @@ writeln(' Definition Identifier found=',copy(Src,ContextNode.StartPos,Params.Id
|
||||
|
||||
ctnProperty:
|
||||
begin
|
||||
MoveCursorToNodeStart(ContextNode);
|
||||
ReadNextAtom; // read keyword 'property'
|
||||
ReadNextAtom; // read name
|
||||
if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
|
||||
then begin
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
||||
exit;
|
||||
if (Src[Params.IdentifierStartPos]<>'[') then begin
|
||||
MoveCursorToNodeStart(ContextNode);
|
||||
ReadNextAtom; // read keyword 'property'
|
||||
ReadNextAtom; // read name
|
||||
if CompareSrcIdentifiers(Params.IdentifierStartPos,CurPos.StartPos)
|
||||
then begin
|
||||
// identifier found
|
||||
Result:=true;
|
||||
Params.SetResult(Self,ContextNode,CurPos.StartPos);
|
||||
exit;
|
||||
end;
|
||||
end else begin
|
||||
// the default property is searched
|
||||
Result:=PropertyIsDefault(ContextNode);
|
||||
if Result then exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -752,7 +766,8 @@ writeln('[TFindDeclarationTool.FindIdentifierInContext] Searching in Parent Con
|
||||
ctnTypeSection, ctnVarSection, ctnConstSection, ctnResStrSection,
|
||||
ctnInterface, ctnImplementation,
|
||||
ctnClassPublished,ctnClassPublic,ctnClassProtected, ctnClassPrivate,
|
||||
ctnRecordCase, ctnRecordVariant:
|
||||
ctnRecordCase, ctnRecordVariant,
|
||||
ctnProcedureHead, ctnParameterList:
|
||||
// these codetreenodes build a parent-child-relationship, but
|
||||
// for pascal it is only a range, hence after searching in the
|
||||
// childs of the last node, it must be searched next in the childs
|
||||
@ -900,12 +915,17 @@ begin
|
||||
ReadPriorAtom;
|
||||
CurAtom:=CurPos;
|
||||
CurAtomType:=GetCurrentAtomType;
|
||||
if CurAtomType=atNone then begin
|
||||
if CurAtomType in [atNone,atSpace,atINHERITED,atRoundBracketOpen,
|
||||
atEdgedBracketOpen,atRoundBracketClose] then begin
|
||||
// no special context found -> the context node is the deepest node at
|
||||
// cursor, and this should already be in Params.ContextNode
|
||||
Result:=Params.ContextNode;
|
||||
exit;
|
||||
end;
|
||||
if (CurAtomType in [atRoundBracketClose,atEdgedBracketClose]) then begin
|
||||
ReadBackTilBracketClose(true);
|
||||
CurAtom.StartPos:=CurPos.StartPos;
|
||||
end;
|
||||
Result:=FindContextNodeAtCursor(Params);
|
||||
if Result=nil then exit;
|
||||
|
||||
@ -934,20 +954,42 @@ writeln('');
|
||||
MoveCursorToCleanPos(NextAtom.StartPos);
|
||||
RaiseException('syntax error: "'+GetAtom+'" found');
|
||||
end;
|
||||
if (Result=Params.ContextNode)
|
||||
and (CompareSrcIdentifier(CurAtom.StartPos,'SELF')) then begin
|
||||
// SELF in a method is the object itself
|
||||
// -> check if in a proc
|
||||
ProcNode:=Params.ContextNode;
|
||||
while (ProcNode<>nil) do begin
|
||||
if (ProcNode.Desc=ctnProcedure) then begin
|
||||
// in a proc -> find the class context
|
||||
if FindClassOfMethod(ProcNode,Params,true) then begin
|
||||
Result:=Params.NewNode;
|
||||
exit;
|
||||
if (Result=Params.ContextNode) then begin
|
||||
if CompareSrcIdentifier(CurAtom.StartPos,'SELF') then begin
|
||||
// SELF in a method is the object itself
|
||||
// -> check if in a proc
|
||||
ProcNode:=Params.ContextNode;
|
||||
while (ProcNode<>nil) do begin
|
||||
if (ProcNode.Desc=ctnProcedure) then begin
|
||||
// in a proc -> find the class context
|
||||
if FindClassOfMethod(ProcNode,Params,true) then begin
|
||||
Result:=Params.NewNode;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ProcNode:=ProcNode.Parent;
|
||||
end;
|
||||
end else if CompareSrcIdentifier(CurAtom.StartPos,'RESULT') then begin
|
||||
// RESULT has a special meaning in a function
|
||||
// -> check if in a function
|
||||
ProcNode:=Params.ContextNode;
|
||||
while (ProcNode<>nil) do begin
|
||||
if (ProcNode.Desc=ctnProcedure) then begin
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CLASS') then ReadNextAtom;
|
||||
if UpAtomIs('FUNCTION') then begin;
|
||||
// in a function -> find the result type
|
||||
BuildSubTreeForProcHead(ProcNode);
|
||||
ProcNode:=ProcNode.FirstChild.FirstChild;
|
||||
if Result.Desc=ctnParameterList then
|
||||
Result:=Result.NextBrother;
|
||||
FindBaseTypeOfNode(Params,Result);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ProcNode:=ProcNode.Parent;
|
||||
end;
|
||||
ProcNode:=ProcNode.Parent;
|
||||
end;
|
||||
end;
|
||||
// find identifier
|
||||
@ -970,6 +1012,7 @@ writeln('');
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
Result:=FindBaseTypeOfNode(Params,Result);
|
||||
end;
|
||||
|
||||
atPoint:
|
||||
@ -1013,17 +1056,56 @@ writeln('');
|
||||
MoveCursorToCleanPos(CurAtom.StartPos);
|
||||
RaiseException('illegal qualifier ^');
|
||||
end;
|
||||
Result:=Result.FirstChild;
|
||||
Result:=FindBaseTypeOfNode(Params,Result.FirstChild);
|
||||
end else if NodeHasParentOfType(Result,ctnPointerType) then begin
|
||||
// this is a pointer type definition
|
||||
// -> the default context is ok
|
||||
end;
|
||||
end;
|
||||
|
||||
atEdgedBracketClose:
|
||||
begin
|
||||
// for example: a[]
|
||||
// this could be:
|
||||
// 1. ranged array
|
||||
// 2. dynamic array
|
||||
// 3. indexed pointer
|
||||
// 4. default property
|
||||
if Result<>Params.ContextNode then begin
|
||||
case Result.Desc of
|
||||
|
||||
ctnArrayType:
|
||||
// the array type is the last child node
|
||||
Result:=FindBaseTypeOfNode(Params,Result.LastChild);
|
||||
|
||||
// ToDo: atINHERITED, atRoundBracketClose, atEdgedBracketClose
|
||||
ctnPointerType:
|
||||
// the pointer type is the only child node
|
||||
Result:=FindBaseTypeOfNode(Params,Result.FirstChild);
|
||||
|
||||
ctnClass:
|
||||
begin
|
||||
Params.Save(OldInput);
|
||||
Params.Flags:=[fdfSearchInAncestors,fdfExceptionOnNotFound]
|
||||
+fdfGlobals*Params.Flags;
|
||||
Params.IdentifierStartPos:=CurAtom.StartPos;
|
||||
Params.IdentifierEndPos:=CurAtom.StartPos+1;
|
||||
Params.ContextNode:=Result;
|
||||
FindIdentifierInContext(Params);
|
||||
Result:=FindBaseTypeOfNode(Params,Params.NewNode);
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
|
||||
else
|
||||
MoveCursorToCleanPos(CurAtom.StartPos);
|
||||
RaiseException('illegal qualifier');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// ToDo: atINHERITED, atRoundBracketClose
|
||||
|
||||
else
|
||||
// expression start found
|
||||
begin
|
||||
if (not (NextAtomType in [atSpace,atIdentifier,atRoundBracketOpen,
|
||||
atEdgedBracketOpen])) then
|
||||
@ -1036,9 +1118,6 @@ writeln('');
|
||||
end;
|
||||
end;
|
||||
|
||||
// try to get the base type of the found context
|
||||
Result:=FindBaseTypeOfNode(Params,Result);
|
||||
|
||||
{$IFDEF CTDEBUG}
|
||||
write('[TFindDeclarationTool.FindContextNodeAtCursor] END ',
|
||||
Params.ContextNode.DescAsString,' CurAtom=',AtomTypeNames[CurAtomType],
|
||||
@ -1088,11 +1167,6 @@ begin
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end else
|
||||
if (Result.Desc=ctnTypeType) then begin
|
||||
// a TypeType is for example 'MyInt = type integer;'
|
||||
// the context is not the 'type' keyword, but the identifier after it.
|
||||
Result:=Result.FirstChild;
|
||||
end else
|
||||
if (Result.Desc=ctnIdentifier) then begin
|
||||
// this type is just an alias for another type
|
||||
// -> search the basic type
|
||||
@ -1113,6 +1187,30 @@ begin
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end else
|
||||
if (Result.Desc=ctnProperty) then begin
|
||||
// this is a property -> search the type definition of the property
|
||||
ReadTilTypeOfProperty(Result);
|
||||
Params.Save(OldInput);
|
||||
try
|
||||
Params.IdentifierStartPos:=CurPos.StartPos;
|
||||
Params.IdentifierEndPos:=CurPos.EndPos;
|
||||
Params.Flags:=[fdfSearchInParentNodes,fdfExceptionOnNotFound]
|
||||
+(fdfGlobals*Params.Flags);
|
||||
Params.ContextNode:=Result.Parent;
|
||||
FindIdentifierInContext(Params);
|
||||
if Result.HasAsParent(Params.NewNode) then
|
||||
break
|
||||
else
|
||||
Result:=Params.NewNode;
|
||||
finally
|
||||
Params.Load(OldInput);
|
||||
end;
|
||||
end else
|
||||
if (Result.Desc=ctnTypeType) then begin
|
||||
// a TypeType is for example 'MyInt = type integer;'
|
||||
// the context is not the 'type' keyword, but the identifier after it.
|
||||
Result:=Result.FirstChild;
|
||||
end else
|
||||
break;
|
||||
end;
|
||||
@ -1139,6 +1237,8 @@ var
|
||||
ClassContextNode: TCodeTreeNode;
|
||||
begin
|
||||
Result:=false;
|
||||
// if proc is a method, search in class
|
||||
// -> find class name
|
||||
MoveCursorToNodeStart(ProcContextNode);
|
||||
ReadNextAtom; // read keyword
|
||||
ReadNextAtom; // read classname
|
||||
|
@ -76,7 +76,8 @@ type
|
||||
phpWithoutName, phpWithVarModifiers, phpWithParameterNames,
|
||||
phpWithDefaultValues, phpWithResultType, phpWithComments, phpInUpperCase,
|
||||
phpWithoutBrackets, phpIgnoreForwards, phpIgnoreProcsWithBody,
|
||||
phpOnlyWithClassname, phpFindCleanPosition, phpWithoutParamList);
|
||||
phpOnlyWithClassname, phpFindCleanPosition, phpWithoutParamList,
|
||||
phpCreateNodes);
|
||||
TProcHeadAttributes = set of TProcHeadAttribute;
|
||||
|
||||
TProcHeadExtractPos = (phepNone, phepStart, phepName, phepParamList);
|
||||
@ -143,7 +144,8 @@ type
|
||||
procedure BuildBlockStatementStartKeyWordFuncList; virtual;
|
||||
function UnexpectedKeyWord: boolean;
|
||||
// read functions
|
||||
function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType: boolean;
|
||||
function ReadTilProcedureHeadEnd(IsMethod, IsFunction, IsType,
|
||||
CreateNodes: boolean;
|
||||
var HasForwardModifier: boolean): boolean;
|
||||
function ReadConstant(ExceptionOnError, Extract: boolean;
|
||||
Attr: TProcHeadAttributes): boolean;
|
||||
@ -162,6 +164,7 @@ type
|
||||
function ReadWithStatement(ExceptionOnError,
|
||||
CreateNodes: boolean): boolean;
|
||||
procedure ReadVariableType;
|
||||
procedure ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode);
|
||||
public
|
||||
CurSection: TCodeTreeNodeDesc;
|
||||
|
||||
@ -176,6 +179,7 @@ type
|
||||
CursorPos: TCodeXYPosition; var CleanCursorPos: integer);
|
||||
procedure BuildSubTreeForClass(ClassNode: TCodeTreeNode); virtual;
|
||||
procedure BuildSubTreeForBeginBlock(BeginNode: TCodeTreeNode); virtual;
|
||||
procedure BuildSubTreeForProcHead(ProcNode: TCodeTreeNode); virtual;
|
||||
function DoAtom: boolean; override;
|
||||
function ExtractPropName(PropNode: TCodeTreeNode;
|
||||
InUpperCase: boolean): string;
|
||||
@ -208,6 +212,7 @@ type
|
||||
function GetSourceType: TCodeTreeNodeDesc;
|
||||
function NodeHasParentOfType(ANode: TCodeTreeNode;
|
||||
NodeDesc: TCodeTreeNodeDesc): boolean;
|
||||
function PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
@ -851,7 +856,7 @@ begin
|
||||
IsFunction:=UpAtomIs('FUNCTION');
|
||||
ReadNextAtom;
|
||||
HasForwardModifier:=false;
|
||||
ReadTilProcedureHeadEnd(true,IsFunction,true,HasForwardModifier);
|
||||
ReadTilProcedureHeadEnd(true,IsFunction,true,false,HasForwardModifier);
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
@ -930,7 +935,7 @@ begin
|
||||
CurNode.Desc:=ctnProcedureHead;
|
||||
// read rest
|
||||
ReadNextAtom;
|
||||
ReadTilProcedureHeadEnd(true,IsFunction,false,HasForwardModifier);
|
||||
ReadTilProcedureHeadEnd(true,IsFunction,false,false,HasForwardModifier);
|
||||
// close procedure header
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
@ -943,6 +948,7 @@ end;
|
||||
function TPascalParserTool.ReadParamList(ExceptionOnError, Extract: boolean;
|
||||
Attr: TProcHeadAttributes): boolean;
|
||||
var CloseBracket: char;
|
||||
Desc: TCodeTreeNodeDesc;
|
||||
begin
|
||||
Result:=false;
|
||||
if AtomIsChar('(') or AtomIsChar('[') then begin
|
||||
@ -950,6 +956,10 @@ begin
|
||||
CloseBracket:=')'
|
||||
else
|
||||
CloseBracket:=']';
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnParameterList;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
@ -958,25 +968,37 @@ begin
|
||||
CloseBracket:=#0;
|
||||
repeat
|
||||
// read parameter prefix modifier
|
||||
if (UpAtomIs('VAR')) or (UpAtomIs('CONST')) or (UpAtomIs('OUT')) then
|
||||
if (UpAtomIs('VAR')) or (UpAtomIs('CONST')) or (UpAtomIs('OUT')) then begin
|
||||
Desc:=ctnVarDefinition;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(phpWithVarModifiers in Attr,Attr);
|
||||
end else
|
||||
Desc:=ctnVarDefinition;
|
||||
// read parameter name(s)
|
||||
repeat
|
||||
AtomIsIdentifier(ExceptionOnError);
|
||||
if not AtomIsIdentifier(ExceptionOnError) then exit;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=Desc;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(phpWithParameterNames in Attr,Attr);
|
||||
if not AtomIsChar(',') then
|
||||
break
|
||||
else
|
||||
else begin
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
ExtractNextAtom(not (phpWithoutParamList in Attr),Attr);
|
||||
end;
|
||||
until false;
|
||||
// read type
|
||||
if (AtomIsChar(':')) then begin
|
||||
@ -995,6 +1017,10 @@ begin
|
||||
Extract and (phpWithDefaultValues in Attr),Attr);
|
||||
end;
|
||||
end;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
// read next parameter
|
||||
if (CurPos.StartPos>SrcLen) then
|
||||
if ExceptionOnError then
|
||||
@ -1018,6 +1044,10 @@ begin
|
||||
RaiseException(
|
||||
'syntax error: '+CloseBracket+' expected, but '+GetAtom+' found')
|
||||
else exit;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
@ -1032,6 +1062,10 @@ begin
|
||||
Result:=false;
|
||||
if AtomIsWord then begin
|
||||
if UpAtomIs('ARRAY') then begin
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnArrayType;
|
||||
end;
|
||||
if not Extract then ReadNextAtom else ExtractNextAtom(true,Attr);
|
||||
if not UpAtomIs('OF') then
|
||||
if ExceptionOnError then
|
||||
@ -1039,6 +1073,12 @@ begin
|
||||
else exit;
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CONST') then begin
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnArrayType;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
@ -1048,6 +1088,12 @@ begin
|
||||
end;
|
||||
end;
|
||||
if not AtomIsIdentifier(ExceptionOnError) then exit;
|
||||
if (phpCreateNodes in Attr) then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnIdentifier;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
if not Extract then
|
||||
ReadNextAtom
|
||||
else
|
||||
@ -1062,7 +1108,7 @@ begin
|
||||
end;
|
||||
|
||||
function TPascalParserTool.ReadTilProcedureHeadEnd(
|
||||
IsMethod, IsFunction, IsType: boolean;
|
||||
IsMethod, IsFunction, IsType, CreateNodes: boolean;
|
||||
var HasForwardModifier: boolean): boolean;
|
||||
{ parse parameter list, result type, of object, method specifiers
|
||||
|
||||
@ -1087,23 +1133,30 @@ function TPascalParserTool.ReadTilProcedureHeadEnd(
|
||||
[alias: <string constant>]
|
||||
}
|
||||
var IsSpecifier: boolean;
|
||||
Attr: TProcHeadAttributes;
|
||||
begin
|
||||
//writeln('[TPascalParserTool.ReadTilProcedureHeadEnd] ',
|
||||
//'Method=',IsMethod,', Function=',IsFunction,', Type=',IsType);
|
||||
Result:=true;
|
||||
HasForwardModifier:=false;
|
||||
if AtomIsChar('(') then
|
||||
ReadParamList(true,false,[]);
|
||||
if AtomIsChar('(') then begin
|
||||
Attr:=[];
|
||||
if CreateNodes then
|
||||
Include(Attr,phpCreateNodes);
|
||||
ReadParamList(true,false,Attr);
|
||||
end;
|
||||
if IsFunction then begin
|
||||
// read function result type
|
||||
if not AtomIsChar(':') then
|
||||
RaiseException('syntax error: : expected, but '+GetAtom+' found');
|
||||
ReadNextAtom;
|
||||
if (CurPos.StartPos>SrcLen)
|
||||
or (not (UpperSrc[CurPos.StartPos] in ['A'..'Z','_']))
|
||||
then
|
||||
RaiseException(
|
||||
'syntax error: method result type expected but '+GetAtom+' found');
|
||||
AtomIsIdentifier(true);
|
||||
if CreateNodes then begin
|
||||
CreateChildNode;
|
||||
CurNode.Desc:=ctnIdentifier;
|
||||
CurNode.EndPos:=CurPos.EndPos;
|
||||
EndChildNode;
|
||||
end;
|
||||
ReadNextAtom;
|
||||
end;
|
||||
if UpAtomIs('OF') then begin
|
||||
@ -1537,7 +1590,7 @@ begin
|
||||
end;
|
||||
// read rest of procedure head
|
||||
HasForwardModifier:=false;
|
||||
ReadTilProcedureHeadEnd(false,IsFunction,false,HasForwardModifier);
|
||||
ReadTilProcedureHeadEnd(false,IsFunction,false,false,HasForwardModifier);
|
||||
if ChildCreated then begin
|
||||
if HasForwardModifier then
|
||||
ProcNode.SubDesc:=ctnsForwardDeclaration;
|
||||
@ -3059,6 +3112,67 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPascalParserTool.ReadTilTypeOfProperty(PropertyNode: TCodeTreeNode);
|
||||
begin
|
||||
MoveCursorToNodeStart(PropertyNode);
|
||||
ReadNextAtom; // read keyword 'property'
|
||||
ReadNextAtom; // read property name
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('[') then begin
|
||||
// read parameter list
|
||||
ReadTilBracketClose(true);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
if not AtomIsChar(':') then
|
||||
RaiseException('syntax error: : expected, but '+GetAtom+' found');
|
||||
ReadNextAtom; // read type
|
||||
AtomIsIdentifier(true);
|
||||
end;
|
||||
|
||||
function TPascalParserTool.PropertyIsDefault(PropertyNode: TCodeTreeNode
|
||||
): boolean;
|
||||
begin
|
||||
Result:=false;
|
||||
if (PropertyNode=nil) or (PropertyNode.Desc<>ctnProperty) then exit;
|
||||
MoveCursorToCleanPos(PropertyNode.EndPos);
|
||||
ReadPriorAtom;
|
||||
if (not AtomIsChar(';')) then exit;
|
||||
ReadPriorAtom;
|
||||
Result:=UpAtomIs('DEFAULT');
|
||||
end;
|
||||
|
||||
procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode);
|
||||
var HasForwardModifier, IsFunction: boolean;
|
||||
begin
|
||||
if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
|
||||
if (ProcNode=nil) or (ProcNode.Desc<>ctnProcedure)
|
||||
or (ProcNode.FirstChild=nil) then
|
||||
RaiseException('[TPascalParserTool.BuildSubTreeForProcHead] '
|
||||
+'internal error: invalid ProcNode');
|
||||
if ProcNode.FirstChild.SubDesc=ctnsProcHeadNodesCreated then exit;
|
||||
MoveCursorToNodeStart(ProcNode);
|
||||
ReadNextAtom;
|
||||
if UpAtomIs('CLASS') then
|
||||
ReadNextAtom;
|
||||
IsFunction:=UpAtomIs('FUNCTION');
|
||||
// read procedure head (= name + parameterlist + resulttype;)
|
||||
CurNode:=ProcNode.FirstChild;
|
||||
ReadNextAtom;// read first atom of head
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom;
|
||||
if AtomIsChar('.') then begin
|
||||
// read procedure name of a class method (the name after the . )
|
||||
ReadNextAtom;
|
||||
AtomIsIdentifier(true);
|
||||
ReadNextAtom;
|
||||
end;
|
||||
// read rest of procedure head and build nodes
|
||||
HasForwardModifier:=false;
|
||||
ReadTilProcedureHeadEnd(false,IsFunction,false,true,HasForwardModifier);
|
||||
ProcNode.FirstChild.SubDesc:=ctnsProcHeadNodesCreated;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
end.
|
||||
|
Loading…
Reference in New Issue
Block a user