paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-10 09:49:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: check objfpc generic procedure has templates

Browse Source 
git-svn-id: trunk@43053 -
This commit is contained in:
Mattias Gaertner 2019-09-22 14:09:58 +00:00
parent 422afb8ebc
commit 64e846ebe9
2 changed files with 50 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-passrc/src/pparser.pp
View File

@ -458,7 +458,8 @@ type
procedure ParseProcAsmBlock(Parent: TProcedureBody);
// Function/Procedure declaration
function ParseProcedureOrFunctionDecl(Parent: TPasElement;
ProcType: TProcType; MustBeGeneric: boolean; AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
ProcType: TProcType; MustBeGeneric: boolean;
AVisibility: TPasMemberVisibility = VisDefault): TPasProcedure;
procedure ParseArgList(Parent: TPasElement;
Args: TFPList; // list of TPasArgument
EndToken: TToken);
@ -3441,7 +3442,7 @@ var
ExpEl: TPasExportSymbol;
PropEl : TPasProperty;
PT : TProcType;
ok: Boolean;
ok, MustBeGeneric: Boolean;
Proc: TPasProcedure;
Attr: TPasAttributes;
CurEl: TPasElement;
@ -3524,23 +3525,25 @@ begin
SetBlock(declProperty);
tkProcedure, tkFunction, tkConstructor, tkDestructor, tkOperator:
begin
MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
SetBlock(declNone);
SaveComments;
pt:=GetProcTypeFromToken(CurToken);
AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, false));
AddProcOrFunction(Declarations, ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
end;
tkClass:
begin
SetBlock(declNone);
SaveComments;
NextToken;
If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
begin
pt:=GetProcTypeFromToken(CurToken,True);
AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, false));
end
else
CheckToken(tkprocedure);
MustBeGeneric:=(not (msDelphi in CurrentModeswitches)) and (GetPrevToken=tkgeneric);
SetBlock(declNone);
SaveComments;
NextToken;
If CurToken in [tkprocedure,tkFunction,tkConstructor,tkDestructor] then
begin
pt:=GetProcTypeFromToken(CurToken,True);
AddProcOrFunction(Declarations,ParseProcedureOrFunctionDecl(Declarations, pt, MustBeGeneric));
end
else
CheckToken(tkprocedure);
end;
tkIdentifier:
begin
@ -3657,6 +3660,8 @@ begin
NextToken;
if (CurToken in [tkprocedure,tkfunction]) then
begin
if msDelphi in CurrentModeswitches then
ParseExcSyntaxError; // inconsistency, tkGeneric should be in Scanner.NonTokens
SetBlock(declNone);
UngetToken;
end;
@ -6441,6 +6446,8 @@ var
else
break;
until false;
if (NameParts=nil) and MustBeGeneric then
CheckToken(tkLessThan);
UngetToken;
end;

32
packages/fcl-passrc/tests/tcresolvegenerics.pas
View File

@ -122,8 +122,9 @@ type
procedure TestGenProc_Function;
procedure TestGenProc_FunctionDelphi;
procedure TestGenProc_OverloadDuplicate;
procedure TestGenProc_MissingTemplatesFail;
procedure TestGenProc_Forward;
//procedure TestGenProc_External;
procedure TestGenProc_External;
//procedure TestGenProc_UnitIntf;
procedure TestGenProc_BackRef1Fail;
procedure TestGenProc_BackRef2Fail;
@ -1749,12 +1750,24 @@ begin
CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,25)',nDuplicateIdentifier);
end;
procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
begin
StartProgram(false);
Add([
'generic procedure Run;',
'begin',
'end;',
'begin',
'']);
CheckParserException('Expected "<"',nParserExpectTokenError);
end;
procedure TTestResolveGenerics.TestGenProc_Forward;
begin
StartProgram(false);
Add([
'generic procedure Fly<T>(a: T); forward;',
'generic procedure Run;',
'procedure Run;',
'begin',
' specialize Fly<word>(3);',
'end;',
@ -1769,6 +1782,21 @@ begin
ParseProgram;
end;
procedure TTestResolveGenerics.TestGenProc_External;
begin
StartProgram(false);
Add([
'generic function Fly<T>(a: T): T; external name ''flap'';',
'procedure Run;',
'begin',
' specialize Fly<word>(3);',
'end;',
'begin',
' specialize Fly<boolean>(true);',
'']);
ParseProgram;
end;
procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
begin
StartProgram(false);