paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 14:38:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

codetools: fixed class completion for method with specialize in mdoe delphi

Browse Source 
git-svn-id: branches/fixes_1_8@56324 -
This commit is contained in:
mattias 2017-11-06 14:53:32 +00:00
parent 4c4229d2f4
commit 3b36f5f568
3 changed files with 79 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
components/codetools/codetree.pas
View File

@ -139,15 +139,15 @@ const
ctnPointerType = 85;
ctnClassOfType = 86; // 1st child = ctnIdentifier
ctnVariantType = 87;
ctnSpecialize = 88; // 1st child = ctnSpecializeType, 2nd child = ctnSpecializeParams
ctnSpecializeType = 89; // parent = ctnSpecialize
ctnSpecializeParams = 90; // list of ctnSpecializeParam, parent = ctnSpecialize
ctnSpecializeParam = 91; // parent = ctnSpecializeParams
ctnGenericType = 92;// 1st child = ctnGenericName, 2nd child = ctnGenericParams, 3th child = type
ctnGenericName = 93; // parent = ctnGenericType
ctnGenericParams = 94; // parent = ctnGenericType, children = ctnGenericParameter
ctnGenericParameter = 95; // can has a child ctnGenericConstraint
ctnGenericConstraint = 96; // parent = ctnGenericParameter
ctnGenericType = 88;// 1st child = ctnGenericName, 2nd child = ctnGenericParams, 3th child = type
ctnGenericName = 89; // parent = ctnGenericType
ctnGenericParams = 90; // parent = ctnGenericType, children = ctnGenericParameter
ctnGenericParameter = 91; // can has a child ctnGenericConstraint
ctnGenericConstraint = 92; // parent = ctnGenericParameter
ctnSpecialize = 93; // 1st child = ctnSpecializeType, 2nd child = ctnSpecializeParams, in mode ObjFPC it starts at keyword 'specialize'
ctnSpecializeType = 94; // parent = ctnSpecialize
ctnSpecializeParams = 95; // list of ctnSpecializeParam, parent = ctnSpecialize
ctnSpecializeParam = 96; // parent = ctnSpecializeParams
ctnReferenceTo = 97; // 1st child = ctnProcedureType
ctnConstant = 98;
ctnHintModifier = 99; // deprecated, platform, unimplemented, library, experimental

1
components/codetools/linkscanner.pas
View File

@ -243,6 +243,7 @@ const
cmsISOLike_Program_Para,
cmsISOLike_Mod]
);
cmAllModesWithGeneric = [cmDELPHI,cmDELPHIUNICODE,cmOBJFPC];
type
// see fpcsrc/compiler/globtype.pas toptimizerswitch

128
components/codetools/pascalparsertool.pas
View File

@ -163,7 +163,7 @@ type
procedure ReadConstExpr;
// types
procedure ReadTypeNameAndDefinition;
procedure ReadGenericParamList;
procedure ReadGenericParamList(Must: boolean);
procedure ReadTypeReference;
procedure ReadClassInterfaceContent;
function KeyWordFuncTypeClass: boolean;
@ -201,7 +201,6 @@ type
function UnexpectedKeyWord: boolean;
function EndOfSourceExpected: boolean;
// read functions
procedure ReadGenericParam;
function ReadTilProcedureHeadEnd(ParseAttr: TParseProcHeadAttributes;
var HasForwardModifier: boolean): boolean;
function ReadConstant(ExceptionOnError, Extract: boolean;
@ -1529,33 +1528,6 @@ begin
Result:=true;
end;
// Support generics in methods parameters and return types
procedure TPascalParserTool.ReadGenericParam;
// example: <a,b<c.d.e>>
var
Level: Integer;
begin
Level:=0;
repeat
if CurPos.Flag in [cafPoint, cafComma] then begin
ReadNextAtom;
AtomIsIdentifierSaveE;
end
else if AtomIsChar('<') then begin
inc(Level);
ReadNextAtom;
AtomIsIdentifierSaveE;
end
else if AtomIsChar('>') then begin
dec(Level);
if Level=0 then break;
end else
SaveRaiseCharExpectedButAtomFound(20170421195437,'>');
ReadNextAtom;
until false;
ReadNextAtom;
end;
function TPascalParserTool.ReadParamType(ExceptionOnError, Extract: boolean;
const Attr: TProcHeadAttributes): boolean;
// after reading, CurPos is the atom after the type
@ -1632,7 +1604,8 @@ begin
end else begin
NeedIdentifier:=false;
end;
end else if UpAtomIs('SPECIALIZE') then begin
end;
if NeedIdentifier and UpAtomIs('SPECIALIZE') then begin
ReadSpecialize(phpCreateNodes in Attr,Extract,Copying,Attr);
NeedIdentifier:=false;
end;
@ -1662,6 +1635,8 @@ begin
if (phpCreateNodes in Attr) then begin
EndChildNode;
end;
if (Scanner.CompilerMode=cmDELPHI) and AtomIsChar('<') then
ReadSpecialize(phpCreateNodes in Attr,Extract,Copying,Attr);
end;
if (phpCreateNodes in Attr) then begin
if IsFileType then begin
@ -1678,9 +1653,7 @@ begin
SaveRaiseStringExpectedButAtomFound(20170421195442,ctsIdentifier)
else exit;
end;
if AtomIsChar('<') then
ReadGenericParam
else if UpAtomIs('LOCATION')
if UpAtomIs('LOCATION')
and (Scanner.Values.IsDefined('CPUM68K') or Scanner.Values.IsDefined('CPUPOWERPC'))
then begin
// for example Domain: LongInt location 'd0'
@ -1780,8 +1753,8 @@ begin
end;
repeat
ReadNextAtom;
if AtomIsChar('<') then
ReadGenericParam;
if (Scanner.CompilerMode=cmDELPHI) and AtomIsChar('<') then
ReadSpecialize(pphCreateNodes in ParseAttr);
if CurPos.Flag<>cafPoint then break;
// unitname.classname<T>.identifier
ReadNextAtom;
@ -2774,13 +2747,7 @@ begin
ReadNextAtom;
end;
end;
if (Scanner.CompilerMode = cmDELPHI) and AtomIsChar('<') then
ReadGenericParamList
else if IsGeneric then begin
if not AtomIsChar('<') then
SaveRaiseCharExpectedButAtomFound(20170710202211,'<');
ReadGenericParamList;
end;
ReadGenericParamList(IsGeneric);
// read rest of procedure head
HasForwardModifier:=false;
ParseAttr:=[];
@ -4059,15 +4026,19 @@ procedure TPascalParserTool.ReadTypeNameAndDefinition;
var
TypeNode: TCodeTreeNode;
NamePos: TAtomPosition;
IsGeneric: Boolean;
begin
CreateChildNode;
TypeNode:=CurNode;
if (Scanner.CompilerMode in [cmOBJFPC,cmFPC]) and UpAtomIs('GENERIC') then begin
IsGeneric:=true;
CurNode.Desc:=ctnGenericType;
ReadNextAtom;
end
else
else begin
IsGeneric:=false;
CurNode.Desc:=ctnTypeDefinition;
end;
// read name
AtomIsIdentifierSaveE;
ReadNextAtom;
@ -4083,8 +4054,8 @@ begin
CurNode.EndPos:=NamePos.EndPos;
//debugln(['TPascalParserTool.ReadTypeNameAndDefinition Name="',copy(Src,NamePos.StartPos,NamePos.EndPos-NamePos.StartPos),'"']);
EndChildNode;
// read parameter list
ReadGenericParamList;
// read generic parameter list
ReadGenericParamList(IsGeneric);
end;
// read =
if (CurPos.Flag<>cafEqual) then
@ -4103,7 +4074,7 @@ begin
EndChildNode;
end;
procedure TPascalParserTool.ReadGenericParamList;
procedure TPascalParserTool.ReadGenericParamList(Must: boolean);
{ At start cursor is on <
At end cursor is on atom after >
@ -4114,6 +4085,12 @@ procedure TPascalParserTool.ReadGenericParamList;
<T1: record; T2,T3: class; T4: constructor; T5: name> = type
}
begin
if not AtomIsChar('<') then begin
if Must then
SaveRaiseCharExpectedButAtomFound(20171106143341,'<');
exit;
end else if not (Scanner.CompilerMode in cmAllModesWithGeneric) then
exit;
CreateChildNode;
CurNode.Desc:=ctnGenericParams;
ReadNextAtom;
@ -4200,10 +4177,16 @@ procedure TPascalParserTool.ReadTypeReference;
controls.TButton
TGenericClass<TypeReference,TypeReference>
TGenericClass<TypeReference,TypeReference>.TNestedClass
specialize TGenericClass<TypeReference,TypeReference>.TNestedClass
}
var SavePos: TAtomPosition;
begin
SavePos := CurPos;
// ToDo: specialize
{if (Scanner.CompilerMode=cmOBJFPC) and UpAtomIs('SPECIALIZE') then begin
IsGeneric:=true;
ReadNextAtom;
end;}
ReadNextAtom;
while CurPos.Flag=cafPoint do begin
ReadNextAtom;
@ -4353,7 +4336,7 @@ var
IsHelper: Boolean;
HelperForNode: TCodeTreeNode;
begin
//debugln(['TPascalParserTool.KeyWordFuncTypeClass ',GetAtom,' ',CleanPosToStr(CurPos.StartPos)]);
//debugln(['TPascalParserTool.KeyWordFuncTypeClass START ',GetAtom,' ',CleanPosToStr(CurPos.StartPos),' ',CurNode.DescAsString]);
// class or 'class of' start found
if UpAtomIs('CLASS') then
ClassDesc:=ctnClass
@ -4372,9 +4355,9 @@ begin
else
SaveRaiseStringExpectedButAtomFound(20170421195754,'class');
ContextDesc:=CurNode.Desc;
if not(ClassDesc in [ctnRecordType, ctnTypeType]) then begin
if not (ContextDesc in [ctnTypeDefinition,ctnGenericType])
then
//debugln(['TPascalParserTool.KeyWordFuncTypeClass ContextDesc=',NodeDescToStr(ContextDesc),' ClassDesc=',NodeDescToStr(ClassDesc),' CurNode=',CurNode.DescAsString,' CurNode.Parent=',CurNode.Parent.DescAsString]);
if not (ClassDesc in [ctnRecordType, ctnTypeType]) then begin
if not (ContextDesc in [ctnTypeDefinition,ctnGenericType]) then
SaveRaiseExceptionFmt(20170421195127,ctsAnonymDefinitionsAreNotAllowed,[GetAtom]);
if CurNode.Parent.Desc<>ctnTypeSection then
SaveRaiseExceptionFmt(20170421195129,ctsNestedDefinitionsAreNotAllowed,[GetAtom]);
@ -5773,9 +5756,11 @@ procedure TPascalParserTool.ReadSpecialize(CreateChildNodes: boolean;
// specialize template
// after parsing the cursor is on the atom behind the >
// examples:
// $mode objfpc:
// type TListOfInteger = specialize TGenericList<integer,string>;
// type TListOfChar = specialize Classes.TGenericList<integer,objpas.integer>;
// type l = class(specialize TFPGObjectList<TControl>)
// $mode delphi: same as objfpc, but without the specialize keyword
procedure Next; inline;
begin
@ -5786,19 +5771,37 @@ procedure TPascalParserTool.ReadSpecialize(CreateChildNodes: boolean;
end;
begin
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecialize;
end;
//debugln(['TPascalParserTool.ReadSpecialize START ',GetAtom]);
if Scanner.CompilerMode=cmOBJFPC then begin
{$IFDEF CheckNodeTool}
if not UpAtomIs('SPECIALIZE') then
SaveRaiseIllegalQualifier(20171106150016);
{$ENDIF}
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecialize;
end;
Next;
end else if Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE] then begin
UndoReadNextAtom;
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecialize;
end;
end else
SaveRaiseIllegalQualifier(20171106145928);
// read identifier (the name of the generic)
Next;
AtomIsIdentifierSaveE;
if CreateChildNodes then begin
CreateChildNode;
CurNode.Desc:=ctnSpecializeType;
CurNode.EndPos:=CurPos.EndPos;
end;
Next;
if Scanner.CompilerMode in [cmDELPHI,cmDELPHIUNICODE] then
ReadNextAtom // if Extract=true: was already extracted
else
Next;
while Curpos.Flag=cafPoint do begin
// first identifier was unitname, now read the type
Next;
@ -5854,6 +5857,7 @@ begin
EndChildNode; // end ctnSpecialize
end;
Next;
//debugln(['TPascalParserTool.ReadSpecialize END ',GetAtom,' ',CurNode.DescAsString]);
end;
function TPascalParserTool.WordIsPropertyEnd: boolean;
@ -5889,7 +5893,7 @@ procedure TPascalParserTool.BuildSubTreeForProcHead(ProcNode: TCodeTreeNode);
var
HasForwardModifier, IsFunction, IsOperator, IsMethod: boolean;
ParseAttr: TParseProcHeadAttributes;
IsProcType: Boolean;
IsProcType, IsGeneric: Boolean;
ProcHeadNode: TCodeTreeNode;
begin
if ProcNode.Desc=ctnProcedureHead then ProcNode:=ProcNode.Parent;
@ -5924,6 +5928,12 @@ begin
IsMethod:=(ProcNode.Parent<>nil) and (ProcNode.Parent.Desc in (AllClasses+AllClassSections));
MoveCursorToNodeStart(ProcNode);
ReadNextAtom;
if (Scanner.CompilerMode in [cmOBJFPC,cmFPC]) and UpAtomIs('GENERIC') then begin
IsGeneric:=true;
CurNode.Desc:=ctnGenericType;
ReadNextAtom;
end else
IsGeneric:=false;
if UpAtomIs('CLASS') then
ReadNextAtom;
IsFunction:=UpAtomIs('FUNCTION');
@ -5944,8 +5954,8 @@ begin
repeat
CheckOperatorProc(IsOperator,IsFunction);
ReadNextAtom;
if AtomIsChar('<') then
ReadGenericParam;
// read generic parameter list
ReadGenericParamList(IsGeneric);
if CurPos.Flag<>cafPoint then break;
ReadNextAtom;
until false;