mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-11 10:29:21 +02:00
fcl-passrc: parser: position of generic function is in front of type params
git-svn-id: trunk@43056 -
This commit is contained in:
Mattias Gaertner
parent
bd1d6f335d
commit
2b76f439fe
@ -5097,7 +5097,7 @@ var
|
||||
end;
|
||||
|
||||
begin
|
||||
writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
|
||||
//writeln('TPasResolver.OnFindProc START ',El.Name,':',GetElementTypeName(El),' itself=',El=Data^.Proc);
|
||||
if not (El is TPasProcedure) then
|
||||
begin
|
||||
// identifier is not a proc
|
||||
@ -8974,7 +8974,6 @@ begin
|
||||
DeclTemplates:=GetProcTemplateTypes(DeclProc);
|
||||
if ImplTemplates<>nil then
|
||||
begin
|
||||
writeln('AAA1 TPasResolver.ReplaceProcScopeImplArgsWithDeclArgs DeclProc=',DeclProc.Name,' ImplProc=',ImplProc.Name,' ',ImplTemplates.Count);
|
||||
if (DeclTemplates=nil) or (ImplTemplates.Count<>DeclTemplates.Count) then
|
||||
RaiseNotYetImplemented(20190912153602,ImplProc); // inconsistency
|
||||
for i:=0 to ImplTemplates.Count-1 do
|
||||
@ -15877,8 +15876,12 @@ var
|
||||
begin
|
||||
{$IF defined(VerbosePasResolver) or defined(VerbosePas2JS)}
|
||||
writeln('InsertBehind Generic=',GetObjName(GenericEl),' Last=',GetObjName(Last));
|
||||
//for i:=0 to List.Count-1 do writeln(' ',GetObjName(TObject(List[i])));
|
||||
{$ENDIF}
|
||||
RaiseNotYetImplemented(20190826150507,El);
|
||||
if GenericEl is TPasProcedure then
|
||||
i:=List.Count-1
|
||||
else
|
||||
RaiseNotYetImplemented(20190826150507,El);
|
||||
end;
|
||||
List.Insert(i+1,NewEl);
|
||||
end;
|
||||
|
||||
@ -6365,6 +6365,7 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
|
||||
): TPasProcedure;
|
||||
var
|
||||
NameParts: TProcedureNameParts;
|
||||
NamePos: TPasSourcePos;
|
||||
|
||||
function ExpectProcName: string;
|
||||
{ Simple procedure:
|
||||
@ -6388,6 +6389,7 @@ var
|
||||
Part: TProcedureNamePart;
|
||||
begin
|
||||
Result:=ExpectIdentifier;
|
||||
NamePos:=CurSourcePos;
|
||||
Cnt:=1;
|
||||
repeat
|
||||
NextToken;
|
||||
@ -6397,6 +6399,7 @@ var
|
||||
begin
|
||||
inc(Cnt);
|
||||
CurName:=ExpectIdentifier;
|
||||
NamePos:=CurSourcePos;
|
||||
Result:=Result+'.'+CurName;
|
||||
if NameParts<>nil then
|
||||
begin
|
||||
@ -6476,12 +6479,14 @@ begin
|
||||
if (ot=otUnknown) then
|
||||
ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
|
||||
Name:=OperatorNames[Ot];
|
||||
NamePos:=CurTokenPos;
|
||||
end;
|
||||
ptAnonymousProcedure,ptAnonymousFunction:
|
||||
begin
|
||||
Name:='';
|
||||
if MustBeGeneric then
|
||||
ParseExcTokenError('generic'); // inconsistency
|
||||
NamePos:=CurTokenPos;
|
||||
end
|
||||
else
|
||||
Name:=ExpectProcName;
|
||||
@ -6490,7 +6495,7 @@ begin
|
||||
if Name<>'' then
|
||||
Parent:=CheckIfOverLoaded(Parent,Name);
|
||||
Result := TPasProcedure(Engine.CreateElement(PC, Name, Parent, AVisibility,
|
||||
CurSourcePos, NameParts));
|
||||
NamePos, NameParts));
|
||||
if NameParts<>nil then
|
||||
begin
|
||||
if Result.NameParts=nil then
|
||||
|
||||
@ -125,17 +125,21 @@ type
|
||||
procedure TestGenProc_MissingTemplatesFail;
|
||||
procedure TestGenProc_Forward;
|
||||
procedure TestGenProc_External;
|
||||
//procedure TestGenProc_UnitIntf;
|
||||
procedure TestGenProc_UnitIntf;
|
||||
procedure TestGenProc_BackRef1Fail;
|
||||
procedure TestGenProc_BackRef2Fail;
|
||||
procedure TestGenProc_BackRef3Fail;
|
||||
//procedure TestGenProc_Inference;
|
||||
// ToDo: forward parametrized impl must not repeat constraints
|
||||
// ToDo: forward parametrized impl overloads
|
||||
// ToDo: parametrized nested proc fail
|
||||
procedure TestGenProc_CallSelf;
|
||||
procedure TestGenProc_ForwardConstraints;
|
||||
procedure TestGenProc_ForwardConstraintsRepeatFail;
|
||||
procedure TestGenProc_ForwardTempNameMismatch;
|
||||
procedure TestGenProc_ForwardOverload;
|
||||
procedure TestGenProc_NestedFail;
|
||||
procedure TestGenMethod_VirtualFail;
|
||||
// ToDo: virtual method cannot have type parameters
|
||||
// ToDo: message method cannot have type parameters
|
||||
// ToDo: interface method cannot have type parameters
|
||||
// ToDo: class interface method cannot have type parameters
|
||||
// ToDo: parametrized method mismatch interface method
|
||||
// ToDo: generic class method overload <T> <S,T>
|
||||
// ToDo: generic class method overload <T>(bool) <T>(word)
|
||||
@ -1747,7 +1751,7 @@ begin
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,25)',nDuplicateIdentifier);
|
||||
CheckResolverException('Duplicate identifier "Fly" at afile.pp(2,22)',nDuplicateIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_MissingTemplatesFail;
|
||||
@ -1797,6 +1801,30 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_UnitIntf;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pas',
|
||||
LinesToStr([
|
||||
'generic function Fly<T>(a: T): T;',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'generic function Fly<T>(a: T): T;',
|
||||
'var i: T;',
|
||||
'begin',
|
||||
' i:=a;',
|
||||
'end;',
|
||||
'']));
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'uses unit2;',
|
||||
'var w: word;',
|
||||
'begin',
|
||||
' w:=specialize Fly<word>(3);',
|
||||
' if specialize Fly<boolean>(false) then ;',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_BackRef1Fail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1833,6 +1861,131 @@ begin
|
||||
CheckResolverException('Wrong number of parameters specified for call to "function Fly<>(untyped)"',nWrongNumberOfParametersForCallTo);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_CallSelf;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function Fly<T>(a: T): T;',
|
||||
' procedure Run;',
|
||||
' begin',
|
||||
' specialize Fly<T>(a);',
|
||||
' specialize Fly<word>(3);',
|
||||
' end;',
|
||||
'begin',
|
||||
' specialize Fly<T>(a);',
|
||||
' specialize Fly<boolean>(true);',
|
||||
'end;',
|
||||
'begin',
|
||||
' specialize Fly<string>(''fast'');',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_ForwardConstraints;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' TBird = class end;',
|
||||
'var b: TBird;',
|
||||
'generic function Fly<T: class>(a: T): T; forward;',
|
||||
'procedure Run;',
|
||||
'begin',
|
||||
' specialize Fly<TBird>(b);',
|
||||
'end;',
|
||||
'generic function Fly<T>(a: T): T;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
' specialize Fly<TBird>(b);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_ForwardConstraintsRepeatFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
'generic function Fly<T: class>(a: T): T; forward;',
|
||||
'generic function Fly<T: class>(a: T): T;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException(sImplMustNotRepeatConstraints,nImplMustNotRepeatConstraints);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_ForwardTempNameMismatch;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function Fly<T>(a: T): T; forward;',
|
||||
'generic function Fly<B>(a: B): B;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Declaration of "Fly<B>" differs from previous declaration at afile.pp(2,23)',
|
||||
nDeclOfXDiffersFromPrevAtY);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_ForwardOverload;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function {#FlyA}Fly<T>(a: T; b: boolean): T; forward; overload;',
|
||||
'generic function {#FlyB}Fly<T>(a: T; w: word): T; forward; overload;',
|
||||
'procedure {#FlyC}Fly; overload;',
|
||||
'begin',
|
||||
' specialize {@FlyA}Fly<longint>(1,true);',
|
||||
' specialize {@FlyB}Fly<string>(''ABC'',3);',
|
||||
'end;',
|
||||
'generic function Fly<T>(a: T; b: boolean): T;',
|
||||
'begin',
|
||||
'end;',
|
||||
'generic function Fly<T>(a: T; w: word): T;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_NestedFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure Fly;',
|
||||
' generic procedure Run<T>(a: T);',
|
||||
' begin',
|
||||
' end;',
|
||||
'begin',
|
||||
' Run<boolean>(true);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenMethod_VirtualFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure Fly;',
|
||||
' generic procedure Run<T>(a: T);',
|
||||
' begin',
|
||||
' end;',
|
||||
'begin',
|
||||
' Run<boolean>(true);',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Type parameters not allowed on nested procedure',nTypeParamsNotAllowedOnX);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestResolveGenerics]);
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user