paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-30 18:41:43 +01:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed parsing delphi specialized interface ancestor, bug #32715

Browse Source 
git-svn-id: trunk@56477 -
This commit is contained in:
mattias 2017-11-23 23:53:58 +00:00
parent c9a3a1cfe0
commit de5a31e9b5
1 changed files with 115 additions and 116 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

231
components/codetools/pascalparsertool.pas
View File

@ -239,6 +239,9 @@ type
procedure ReadClassInheritance(CreateChildNodes: boolean); procedure ReadClassInheritance(CreateChildNodes: boolean);
procedure ReadSpecialize(CreateChildNodes: boolean; Extract: boolean = false; procedure ReadSpecialize(CreateChildNodes: boolean; Extract: boolean = false;
Copying: boolean = false; const Attr: TProcHeadAttributes = []); Copying: boolean = false; const Attr: TProcHeadAttributes = []);
procedure ReadSpecializeParams(CreateChildNodes: boolean; Extract: boolean = false;
Copying: boolean = false; const Attr: TProcHeadAttributes = []);
procedure ReadAnsiStringParams;
function WordIsPropertyEnd: boolean; function WordIsPropertyEnd: boolean;
function AllowAttributes: boolean; inline; function AllowAttributes: boolean; inline;
public public
@ -1755,29 +1758,7 @@ begin
// read function result type // read function result type
if CurPos.Flag=cafColon then begin if CurPos.Flag=cafColon then begin
ReadNextAtom; ReadNextAtom;
if UpAtomIs('SPECIALIZE') then ReadTypeReference(pphCreateNodes in ParseAttr);
ReadSpecialize(pphCreateNodes in ParseAttr)
else begin
AtomIsIdentifierSaveE;
if (pphCreateNodes in ParseAttr) then begin
CreateChildNode;
CurNode.Desc:=ctnIdentifier;
CurNode.EndPos:=CurPos.EndPos;
end;
repeat
ReadNextAtom;
if (Scanner.CompilerMode=cmDELPHI) and AtomIsChar('<') then
ReadSpecialize(pphCreateNodes in ParseAttr);
if CurPos.Flag<>cafPoint then break;
// unitname.classname<T>.identifier
ReadNextAtom;
AtomIsIdentifierSaveE;
if (pphCreateNodes in ParseAttr) then
CurNode.EndPos:=CurPos.EndPos;
until false;
if (pphCreateNodes in ParseAttr) then
EndChildNode;
end;
end end
else begin else begin
if (Scanner.CompilerMode<>cmDelphi) then if (Scanner.CompilerMode<>cmDelphi) then
@ -4290,11 +4271,11 @@ procedure TPascalParserTool.ReadTypeReference(CreateNodes: boolean);
TGenericClass<TypeRef,TypeRef> TGenericClass<TypeRef,TypeRef>
TGenericClass<TypeRef,TypeRef>.TNestedClass<TypeRef> TGenericClass<TypeRef,TypeRef>.TNestedClass<TypeRef>
specialize TGenericClass<TypeRef,TypeRef> specialize TGenericClass<TypeRef,TypeRef>
atype<char>.subtype
} }
var var
SavePos: TAtomPosition; Cnt: Integer;
begin begin
SavePos := CurPos;
if (Scanner.CompilerMode=cmOBJFPC) and UpAtomIs('SPECIALIZE') then begin if (Scanner.CompilerMode=cmOBJFPC) and UpAtomIs('SPECIALIZE') then begin
ReadSpecialize(CreateNodes); ReadSpecialize(CreateNodes);
exit; exit;
@ -4304,21 +4285,40 @@ begin
CurNode.Desc:=ctnIdentifier; CurNode.Desc:=ctnIdentifier;
end; end;
ReadNextAtom; ReadNextAtom;
Cnt:=1;
while CurPos.Flag=cafPoint do begin while CurPos.Flag=cafPoint do begin
ReadNextAtom; ReadNextAtom;
AtomIsIdentifierSaveE; AtomIsIdentifierSaveE;
ReadNextAtom; ReadNextAtom;
inc(Cnt,2);
end; end;
if AtomIsChar('<') then begin if AtomIsChar('<') then begin
if Scanner.CompilerMode <> cmDELPHI then if ((Cnt=1) and LastUpAtomIs(-1,'STRING'))
RaiseException(20170421195124,'Unexpected character "<"'); or ((Cnt=3) and LastUpAtomIs(-3,'SYSTEM') and LastUpAtomIs(-1,'STRING'))
if CreateNodes then begin then begin
EndChildNode; // e.g. string<codepage>
Tree.DeleteNode(CurNode.LastChild); ReadAnsiStringParams;
ReadNextAtom;
end
else if (Scanner.CompilerMode=cmDELPHI) then begin
// e.g. atype<params>
if CreateNodes then begin
CurNode.Desc:=ctnSpecialize;
CreateChildNode;
CurNode.Desc:=ctnSpecializeType;
CurNode.StartPos:=CurNode.Parent.StartPos;
CurNode.EndPos:=CurPos.StartPos;
EndChildNode;
end;
ReadSpecializeParams(CreateNodes);
ReadNextAtom;
while CurPos.Flag=cafPoint do begin
// e.g. atype<params>.subtype
ReadNextAtom;
AtomIsIdentifierSaveE;
ReadNextAtom;
end;
end; end;
MoveCursorToAtomPos(SavePos);
ReadSpecialize(CreateNodes);
exit;
end; end;
if CreateNodes then begin if CreateNodes then begin
CurNode.EndPos:=CurPos.StartPos; CurNode.EndPos:=CurPos.StartPos;
@ -5817,22 +5817,7 @@ begin
ReadNextAtom; ReadNextAtom;
if CurPos.Flag<>cafRoundBracketClose then begin if CurPos.Flag<>cafRoundBracketClose then begin
repeat repeat
if UpAtomIs('SPECIALIZE') then begin ReadTypeReference(CreateChildNodes);
// specialize Identifier<Identifier>
ReadSpecialize(CreateChildNodes);
end else begin
// read Identifier or Unit.Identifier
AtomIsIdentifierSaveE;
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnIdentifier;
end;
ReadTypeReference(CreateChildNodes);
if (CurNode.EndPos < 0) and CreateChildNodes then begin
CurNode.EndPos:=CurPos.EndPos;
EndChildNode;
end;
end;
// read comma or ) // read comma or )
if CurPos.Flag=cafRoundBracketClose then break; if CurPos.Flag=cafRoundBracketClose then break;
if CurPos.Flag<>cafComma then if CurPos.Flag<>cafComma then
@ -5866,8 +5851,6 @@ procedure TPascalParserTool.ReadSpecialize(CreateChildNodes: boolean;
ExtractNextAtom(Copying,Attr); ExtractNextAtom(Copying,Attr);
end; end;
var
Identifier: String;
begin begin
//debugln(['TPascalParserTool.ReadSpecialize START ',GetAtom]); //debugln(['TPascalParserTool.ReadSpecialize START ',GetAtom]);
if Scanner.CompilerMode=cmOBJFPC then begin if Scanner.CompilerMode=cmOBJFPC then begin
@ -5891,7 +5874,6 @@ begin
// read identifier (the name of the generic) // read identifier (the name of the generic)
AtomIsIdentifierSaveE; AtomIsIdentifierSaveE;
Identifier:=GetAtom;
if CreateChildNodes then begin if CreateChildNodes then begin
CreateChildNode; CreateChildNode;
CurNode.Desc:=ctnSpecializeType; CurNode.Desc:=ctnSpecializeType;
@ -5902,10 +5884,8 @@ begin
else else
Next; Next;
while Curpos.Flag=cafPoint do begin while Curpos.Flag=cafPoint do begin
// first identifier was unitname, now read the type
Next; Next;
AtomIsIdentifierSaveE; AtomIsIdentifierSaveE;
Identifier:=Identifier+'.'+GetAtom;
if CreateChildNodes then if CreateChildNodes then
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
Next; Next;
@ -5913,69 +5893,9 @@ begin
if CreateChildNodes then begin if CreateChildNodes then begin
EndChildNode; // end ctnSpecializeType EndChildNode; // end ctnSpecializeType
end; end;
// read type list
if not AtomIsChar('<') then ReadSpecializeParams(CreateChildNodes,Extract,Copying,Attr);
SaveRaiseCharExpectedButAtomFound(20170421195916,'<');
if CreateChildNodes then begin if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecializeParams;
end;
if (CompareIdentifiers(PChar(Identifier),'string')=0)
or (CompareIdentifiers(PChar(Identifier),'system.string')=0) then begin
// string<codepage>
repeat
Next;
if AtomIsChar('>') then break;
case CurPos.Flag of
cafRoundBracketOpen,cafEdgedBracketOpen: ReadTilBracketClose(true);
cafNone:
if (CurPos.StartPos>SrcLen) then
SaveRaiseCharExpectedButAtomFound(20170421195831,'>')
else if (((CurPos.EndPos-CurPos.StartPos=1)
and (Src[CurPos.StartPos] in ['+','-','*','&','$'])))
or AtomIsNumber
then begin
end else begin
SaveRaiseCharExpectedButAtomFound(20170421195834,'>')
end;
else
SaveRaiseCharExpectedButAtomFound(20170421195837,'>');
end;
until false;
end else begin
// read list of types
repeat
// read identifier (a parameter of the generic type)
Next;
AtomIsIdentifierSaveE;
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecializeParam;
CurNode.EndPos:=CurPos.EndPos;
end;
Next;
while Curpos.Flag=cafPoint do begin
// first identifier was unitname, now read the type
Next;
AtomIsIdentifierSaveE;
if CreateChildNodes then
CurNode.EndPos:=CurPos.EndPos;
Next;
end;
if CreateChildNodes then
EndChildNode; // close ctnSpecializeParam
if AtomIsChar('>') then
break
else if CurPos.Flag=cafComma then begin
// read next parameter
end else
SaveRaiseCharExpectedButAtomFound(20170421195918,'>');
until false;
end;
if CreateChildNodes then begin
// close list
CurNode.EndPos:=CurPos.EndPos;
EndChildNode; // end ctnSpecializeParams
// close specialize // close specialize
CurNode.EndPos:=CurPos.EndPos; CurNode.EndPos:=CurPos.EndPos;
EndChildNode; // end ctnSpecialize EndChildNode; // end ctnSpecialize
@ -5984,6 +5904,85 @@ begin
//debugln(['TPascalParserTool.ReadSpecialize END ',GetAtom,' ',CurNode.DescAsString]); //debugln(['TPascalParserTool.ReadSpecialize END ',GetAtom,' ',CurNode.DescAsString]);
end; end;
procedure TPascalParserTool.ReadSpecializeParams(CreateChildNodes: boolean;
Extract: boolean; Copying: boolean; const Attr: TProcHeadAttributes);
// after readig CurPos is at the >
procedure Next; inline;
begin
if not Extract then
ReadNextAtom
else
ExtractNextAtom(Copying,Attr);
end;
begin
// read params
if not AtomIsChar('<') then
SaveRaiseCharExpectedButAtomFound(20170421195916,'<');
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecializeParams;
end;
// read list of types
repeat
// read identifier (a parameter of the generic type)
Next;
AtomIsIdentifierSaveE;
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecializeParam;
CurNode.EndPos:=CurPos.EndPos;
end;
Next;
while Curpos.Flag=cafPoint do begin
// first identifier was unitname, now read the type
Next;
AtomIsIdentifierSaveE;
if CreateChildNodes then
CurNode.EndPos:=CurPos.EndPos;
Next;
end;
if CreateChildNodes then
EndChildNode; // close ctnSpecializeParam
if AtomIsChar('>') then
break
else if CurPos.Flag=cafComma then begin
// read next parameter
end else
SaveRaiseCharExpectedButAtomFound(20170421195918,'>');
until false;
if CreateChildNodes then begin
// close list
CurNode.EndPos:=CurPos.EndPos;
EndChildNode; // end ctnSpecializeParams
end;
end;
procedure TPascalParserTool.ReadAnsiStringParams;
begin
// string<codepage>
repeat
ReadNextAtom;
if AtomIsChar('>') then break;
case CurPos.Flag of
cafRoundBracketOpen,cafEdgedBracketOpen: ReadTilBracketClose(true);
cafNone:
if (CurPos.StartPos>SrcLen) then
SaveRaiseCharExpectedButAtomFound(20170421195831,'>')
else if (((CurPos.EndPos-CurPos.StartPos=1)
and (Src[CurPos.StartPos] in ['+','-','*','&','$'])))
or AtomIsNumber
then begin
end else begin
SaveRaiseCharExpectedButAtomFound(20170421195834,'>')
end;
else
SaveRaiseCharExpectedButAtomFound(20170421195837,'>');
end;
until false;
end;
function TPascalParserTool.WordIsPropertyEnd: boolean; function TPascalParserTool.WordIsPropertyEnd: boolean;
var var
p: PChar; p: PChar;