MG: find declaration of class ancestor, result type, default property, array, indexed pointer

git-svn-id: trunk@602 -
This commit is contained in:
lazarus 2002-01-16 17:22:11 +00:00
parent eb66cd1363
commit 147fbd54ee
4 changed files with 317 additions and 97 deletions

View File

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

View File

@ -224,6 +224,10 @@ begin
// CodeTreeNodeSubDescriptors
ctnsForwardDeclaration : Result:='Forward';
end;
ctnProcedureHead:
case SubDesc of
ctnsProcHeadNodesCreated: Result:='Nodes Created';
end;
end;
end;

View File

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

View File

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