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

implemented searching for TVarData on array of const

Browse Source 
git-svn-id: trunk@8010 -
This commit is contained in:
mattias 2005-10-31 01:21:28 +00:00
parent 937eb5fe69
commit eb248f3684
3 changed files with 39 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
components/codetools/codetree.pas
View File

@ -333,6 +333,7 @@ begin
ctnIdentifier: Result:='Identifier';
ctnOpenArrayType: Result:='Open Array Type';
ctnOfConstType: Result:='Of Const';
ctnRangedArrayType: Result:='Ranged Array Type';
ctnRecordType: Result:='Record Type';
ctnRecordCase: Result:='Record Case';
@ -355,7 +356,7 @@ begin
ctnCaseStatement: Result:='Case Statement';
else
Result:='invalid descriptor';
Result:='invalid descriptor ('+IntToStr(Desc)+')';
end;
end;

46
components/codetools/finddeclarationtool.pas
View File

@ -3879,11 +3879,11 @@ begin
if ClassNode.Desc=ctnClass then begin
// if this class is not TObject, TObject is class ancestor
SearchBaseClass:=
not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
not CompareSrcIdentifier(ClassIdentNode.StartPos,'TObject');
end else begin
// if this class is not IInterface, IInterface is ancestor
SearchBaseClass:=
not CompareSrcIdentifier(ClassIdentNode.StartPos,'IInterface');
not CompareSrcIdentifier(ClassIdentNode.StartPos,'IInterface');
end;
if not SearchBaseClass then exit;
end;
@ -5136,12 +5136,13 @@ var
procedure ResolveEdgedBracketOpen;
{ for example: a[]
this could be:
1. ranged array
2. dynamic array
3. indexed pointer
4. default property
5. indexed property
6. string character
1. ranged array e.g. array[1..2] of
2. dynamic array e.g. array of integer
3. variant array e.g. array of const
4. indexed pointer e.g. PInteger[1]
5. default property e.g. Items[Index: integer]
6. indexed property e.g. Items[Index: integer]
7. string character e.g. string[3]
}
procedure RaiseTypeIdentNotFound;
@ -5176,13 +5177,36 @@ var
ExprType.Context.Node:=nil;
exit;
end;
//debugln('ResolveEdgedBracketOpen A ',ExprType.Context.Node.DescAsString);
case ExprType.Context.Node.Desc of
ctnOpenArrayType,ctnRangedArrayType:
// the array type is the last child node
ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,
ExprType.Context.Node.LastChild);
begin
// the array type is the last child node
//debugln('ResolveEdgedBracketOpen Open/RangedArray LastChild=',ExprType.Context.Node.LastChild.DescAsString);
if ExprType.Context.Node.LastChild.Desc=ctnOfConstType then begin
// 'array of const'; the array type is 'TVarData'
// => search 'TVarData'
Params.Save(OldInput);
Params.Flags:=[fdfSearchInParentNodes,fdfIgnoreCurContextNode,
fdfExceptionOnNotFound]
+fdfGlobals*Params.Flags
-[fdfTopLvlResolving];
// special identifier for TVarData
Params.SetIdentifier(Self,'tvardata',nil);
Params.ContextNode:=ExprType.Context.Node;
ExprType.Context.Tool.FindIdentifierInContext(Params);
ExprType.Context:=Params.NewCodeTool.FindBaseTypeOfNode(Params,
Params.NewNode);
Params.Load(OldInput);
end else begin
ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,
ExprType.Context.Node.LastChild);
end;
end;
ctnPointerType:
// the pointer type is the only child node
ExprType.Context:=ExprType.Context.Tool.FindBaseTypeOfNode(Params,

4
components/codetools/pascalparsertool.pas
View File

@ -2896,7 +2896,7 @@ function TPascalParserTool.KeyWordFuncTypeArray: boolean;
}
begin
CreateChildNode;
// first set the type to open arrar (an array type without brackets)
// first set the type to open array (an array type without brackets)
CurNode.Desc:=ctnOpenArrayType;
ReadNextAtom;
if (CurPos.Flag=cafEdgedBracketOpen) then begin
@ -2919,7 +2919,7 @@ begin
RaiseStringExpectedButAtomFound('"of"');
ReadNextAtom;
Result:=TypeKeyWordFuncList.DoItUpperCase(UpperSrc,CurPos.StartPos,
CurPos.EndPos-CurPos.StartPos);
CurPos.EndPos-CurPos.StartPos);
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
Result:=true;