codetools: parse multi dim arrays, patch from Paul W, issue #25045

git-svn-id: trunk@54719 -
This commit is contained in:
mattias 2017-04-25 07:08:42 +00:00
parent d7b05763d1
commit 22350effc4
4 changed files with 122 additions and 40 deletions

View File

@ -9335,7 +9335,7 @@ var
{$ENDIF}
if fdfExtractOperand in Params.Flags then begin
// simple copying, todo: expand argument
Params.AddOperandPart(Copy(Src, CurPos.StartPos, CurAtomBracketEndPos-CurPos.StartPos));
Params.AddOperandPart(ExtractBrackets(CurPos.StartPos,[]));
end;
if (not (NextAtomType in [vatSpace,vatPoint,vatAs,vatUp,vatRoundBracketClose,
vatRoundBracketOpen,vatEdgedBracketClose,vatEdgedBracketOpen]))
@ -9378,6 +9378,27 @@ var
RaiseIllegalQualifierFound;
end;
if ExprType.Context.Node.Desc in [ctnRangedArrayType,ctnOpenArrayType] then
begin
MoveCursorToCleanPos(CurAtom.StartPos);
ReadNextAtom; // "["
ReadNextAtom;
repeat
case CurPos.Flag of
cafRoundBracketClose: SaveRaiseBracketCloseExpectedButAtomFound(20170425090717);
cafRoundBracketOpen,
cafEdgedBracketOpen: ReadTilBracketClose(true);
cafComma:
with ExprType, Context do begin
Context:=Tool.FindBaseTypeOfNode(Params,Node.LastChild);
if not (Node.Desc in [ctnRangedArrayType,ctnOpenArrayType]) then
RaiseIllegalQualifierFound;
end;
end;
ReadNextAtom;
until CurPos.Flag=cafEdgedBracketClose;
end;
{$IFDEF ShowExprEval}
DebugLn([' FindExpressionTypeOfTerm ResolveEdgedBracketOpen ExprType=',ExprTypeToString(ExprType)]);
{$ENDIF}
@ -11370,6 +11391,16 @@ function TFindDeclarationTool.CheckParameterSyntax(StartPos,
then begin
// parameter list ended in front of Variable => continue search
{$IFDEF VerboseCPS}DebugLn('CheckIdentifierAndParameterList parameter list ended in front of cursor');{$ENDIF}
if CurPos.Flag=cafEdgedBracketClose then begin
ReadNextAtom;
if CurPos.Flag=cafEdgedBracketOpen then begin
// [][] is equal to [,]
ParameterStart:=CurPos.EndPos;
inc(CurParameterIndex);
continue;
end else
UndoReadNextAtom;
end;
exit;
end else begin
// invalid closing bracket found

View File

@ -4521,42 +4521,60 @@ function TPascalParserTool.KeyWordFuncTypeArray: boolean;
array[SubRange,SubRange,...] of ...
array[Subrange]; // without "of" means array of byte
}
begin
CreateChildNode;
// first set the type to open array (an array type without brackets)
CurNode.Desc:=ctnOpenArrayType;
ReadNextAtom;
if (CurPos.Flag=cafEdgedBracketOpen) then begin
repeat
ReadNextAtom;
// this is a ranged array -> change type
CurNode.Desc:=ctnRangedArrayType;
CreateChildNode;
CurNode.Desc:=ctnRangeType;
ReadSubRange(true);
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
EndChildNode; // close ctnRangeType
if (CurPos.Flag=cafEdgedBracketClose) then break;
if (CurPos.Flag<>cafComma) then
SaveRaiseCharExpectedButAtomFound(20170421195805,']');
until false;
ReadNextAtom;
function ReadElemType: boolean;
begin
if CurPos.Flag in [cafSemicolon,cafRoundBracketClose,cafEdgedBracketClose]
then begin
// array[] without "of" means array[] of byte
CurNode.EndPos:=CurPos.StartPos;
EndChildNode; // close array
exit(true);
Result:=true;
end else begin
if not UpAtomIs('OF') then
SaveRaiseStringExpectedButAtomFound(20170425090708,'"of"');
ReadNextAtom;
Result:=ParseType(CurPos.StartPos);
CurNode.EndPos:=CurPos.StartPos;
EndChildNode; // close array
end;
end;
if not UpAtomIs('OF') then
SaveRaiseStringExpectedButAtomFound(20170421195808,'"of"');
ReadNextAtom;
Result:=ParseType(CurPos.StartPos);
CurNode.EndPos:=CurPos.StartPos;
EndChildNode; // close array
//debugln(['TPascalParserTool.KeyWordFuncTypeArray END Atom=',GetAtom,' CurNode=',CurNode.DescAsString]);
Result:=true;
function ReadIndexType: boolean;
begin
ReadNextAtom;
CreateChildNode;
CurNode.Desc:=ctnRangeType;
ReadSubRange(true);
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
EndChildNode; // close ctnRangeType
if CurPos.Flag=cafComma then begin
// "array [T1,T2]" is equal to "array [T1] of array [T2]"
// so they should be parsed to the same CodeTree
CreateChildNode;
CurNode.Desc:=ctnRangedArrayType;
Result:=ReadIndexType();
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
EndChildNode; // close ctnRangedArrayType
end else begin
if CurPos.Flag<>cafEdgedBracketClose then
SaveRaiseCharExpectedButAtomFound(20170425090712,']');
ReadNextAtom;
CurNode.EndPos:=LastAtoms.GetValueAt(0).EndPos;
Result:=ReadElemType;
end;
end;
begin
CreateChildNode;
// first set the type to open array (an array type without brackets)
CurNode.Desc:=ctnOpenArrayType;
if (CurPos.Flag=cafEdgedBracketOpen) then begin
CurNode.Desc:=ctnRangedArrayType;
Result:=ReadIndexType;
exit;
end;
Result:=ReadElemType;
end;
function TPascalParserTool.KeyWordFuncTypeProc: boolean;

View File

@ -263,6 +263,8 @@ type
// arrays
function ExtractArrayRange(ArrayNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
function ExtractArrayRanges(ArrayNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
// module sections
function ExtractSourceName: string;
@ -3176,6 +3178,32 @@ begin
Result:=ExtractBrackets(CurPos.StartPos,Attr);
end;
function TPascalReaderTool.ExtractArrayRanges(ArrayNode: TCodeTreeNode;
Attr: TProcHeadAttributes): string;
const
AllArrays = [ctnRangedArrayType, ctnOpenArrayType];
var
i: Integer;
begin
Result:='';
if (ArrayNode=nil) or not (ArrayNode.Desc in AllArrays) then exit;
while Assigned(ArrayNode.Parent) and (ArrayNode.Parent.Desc in AllArrays) do
ArrayNode:=ArrayNode.Parent;
MoveCursorToNodeStart(ArrayNode);
if not ReadNextUpAtomIs('ARRAY') then exit;
repeat
if Result<>'' then Result:=Result+',';
if ArrayNode.Desc=ctnRangedArrayType then begin
MoveCursorToNodeStart(ArrayNode.FirstChild); // FirstChild=Index type
Result:=Result+ExtractNode(ArrayNode.FirstChild,Attr);
end else begin
Result:=Result+'PtrUInt';
end;
ArrayNode:=ArrayNode.LastChild;
until not (ArrayNode.Desc in AllArrays);
Result:='['+Result+']';
end;
function TPascalReaderTool.PropertyIsDefault(PropertyNode: TCodeTreeNode): boolean;
begin
Result:=false;

View File

@ -338,8 +338,18 @@ begin
end;
')',']':
begin
if BracketLevel=1 then begin
if Code[TokenStart]=']' then begin
ReadRawNextPascalAtom(Code,TokenEnd,TokenStart);
if TokenEnd=TokenStart then exit;
if Code[TokenStart]='[' then begin
inc(NewParameterIndex);
continue; // [][] is full version of [,]
end
end else
exit;// cursor behind procedure call
end;
dec(BracketLevel);
if BracketLevel=0 then exit;// cursor behind procedure call
end;
',':
if BracketLevel=1 then inc(NewParameterIndex);
@ -403,14 +413,9 @@ procedure TCodeContextFrm.CreateHints(const CodeContexts: TCodeContextInfo);
phpWithResultType]);
Result:=true;
end;
ctnOpenArrayType:
ctnOpenArrayType,ctnRangedArrayType:
begin
s:=s+'[Index: PtrUInt]';
Result:=true;
end;
ctnRangedArrayType:
begin
s:=s+ExprTool.ExtractArrayRange(ExprNode,[]);
s:=s+ExprTool.ExtractArrayRanges(ExprNode,[]);
Result:=true;
end;
end;
@ -633,10 +638,10 @@ procedure TCodeContextFrm.MarkCurrentParameterInHints(ParameterIndex: integer);
repeat
inc(p);
until (p>=length(Result)) or (Result[p]='''');
'a'..'z','A'..'Z','_':
'a'..'z','A'..'Z','_','0'..'9':
if (BracketLevel=1) and (not ReadingType) then begin
WordStart:=p;
while (p<=length(Result)) and (IsIdentChar[Result[p]]) do
while (p<=length(Result)) and IsDottedIdentChar[Result[p]] do
inc(p);
WordEnd:=p;
//DebugLn('MarkCurrentParameterInHint Word=',copy(Result,WordStart,WordEnd-WordStart));