mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 04:49:07 +02:00
pastojs: fixed find generic proc overload without params, issue 38796
This commit is contained in:
mattias
parent
473db46e08
commit
d31e219510
@ -1415,6 +1415,7 @@ type
|
||||
TPRFindGenericData = record
|
||||
Find: TPRFindData;
|
||||
TemplateCount: integer;
|
||||
LastProc: TPasProcedure;
|
||||
end;
|
||||
PPRFindGenericData = ^TPRFindGenericData;
|
||||
|
||||
@ -1593,6 +1594,7 @@ type
|
||||
procedure OnFindProcDeclaration(El: TPasElement; ElScope, StartScope: TPasScope;
|
||||
FindProcData: Pointer; var Abort: boolean); virtual;
|
||||
function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
|
||||
function IsProcOverload(LastProc, CurProc: TPasProcedure): boolean;
|
||||
function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
|
||||
Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
|
||||
protected
|
||||
@ -5009,19 +5011,65 @@ procedure TPasResolver.OnFindFirst_GenericEl(El: TPasElement; ElScope,
|
||||
var
|
||||
Data: PPRFindGenericData absolute FindFirstGenericData;
|
||||
GenericTemplateTypes: TFPList;
|
||||
Proc: TPasProcedure;
|
||||
ProcScope: TPasProcedureScope;
|
||||
begin
|
||||
Proc:=nil;
|
||||
if El is TPasGenericType then
|
||||
GenericTemplateTypes:=TPasGenericType(El).GenericTemplateTypes
|
||||
else if El is TPasProcedure then
|
||||
GenericTemplateTypes:=GetProcTemplateTypes(TPasProcedure(El))
|
||||
begin
|
||||
Proc:=TPasProcedure(El);
|
||||
ProcScope:=Proc.CustomData as TPasProcedureScope;
|
||||
if ProcScope.DeclarationProc<>nil then
|
||||
begin
|
||||
// this proc has a forward declaration -> use that instead
|
||||
Proc:=ProcScope.DeclarationProc;
|
||||
El:=Proc;
|
||||
end;
|
||||
|
||||
if (Data^.LastProc<>nil) and not IsProcOverload(Data^.LastProc,Proc) then
|
||||
begin
|
||||
Abort:=true;
|
||||
exit;
|
||||
end;
|
||||
Data^.LastProc:=Proc;
|
||||
|
||||
GenericTemplateTypes:=GetProcTemplateTypes(Proc);
|
||||
end
|
||||
else
|
||||
exit;
|
||||
|
||||
if GenericTemplateTypes=nil then exit;
|
||||
if GenericTemplateTypes.Count<>Data^.TemplateCount then
|
||||
exit;
|
||||
|
||||
if Data^.Find.Found<>nil then
|
||||
begin
|
||||
// there was already a generic proc, but it needed params
|
||||
if ProcNeedsParams(Proc.ProcType) then
|
||||
begin
|
||||
// this one needs params too
|
||||
// -> keep the first found and continue searching
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Data^.Find.Found:=El;
|
||||
Data^.Find.ElScope:=ElScope;
|
||||
Data^.Find.StartScope:=StartScope;
|
||||
|
||||
if Proc<>nil then
|
||||
begin
|
||||
if (not Proc.IsOverload) and (msDelphi in ProcScope.ModeSwitches) then
|
||||
// stop searching after this proc
|
||||
else if ProcNeedsParams(Proc.ProcType) then
|
||||
begin
|
||||
// continue searching for an overload proc without params
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
Abort:=true;
|
||||
end;
|
||||
|
||||
@ -5069,30 +5117,6 @@ begin
|
||||
// there is already a previous proc
|
||||
PrevProc:=TPasProcedure(Data^.Found);
|
||||
|
||||
if msDelphi in TPasProcedureScope(Data^.LastProc.CustomData).ModeSwitches then
|
||||
begin
|
||||
if (not Data^.LastProc.IsOverload) or (not Proc.IsOverload) then
|
||||
begin
|
||||
Abort:=true;
|
||||
exit;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// mode objfpc
|
||||
if IsSameProcContext(Proc.Parent,Data^.LastProc.Parent) then
|
||||
// mode objfpc: procs in same context have implicit overload
|
||||
else
|
||||
begin
|
||||
// mode objfpc, different context
|
||||
if not ProcHasGroupOverload(Data^.LastProc) then
|
||||
begin
|
||||
Abort:=true;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (Data^.Distance=cExact) and (PrevProc.Parent<>Proc.Parent)
|
||||
and (PrevProc.Parent.ClassType=TPasClassType) then
|
||||
begin
|
||||
@ -5101,12 +5125,12 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
// check if previous found proc is override of found proc
|
||||
if IsProcOverride(Proc,PrevProc) then
|
||||
if not IsProcOverload(Data^.LastProc,Proc) then
|
||||
begin
|
||||
// previous found proc is override of found proc -> skip
|
||||
Abort:=true;
|
||||
exit;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
if (msDelphi in ProcScope.ModeSwitches) and not Proc.IsOverload then
|
||||
@ -5592,6 +5616,36 @@ begin
|
||||
Result:=false;
|
||||
end;
|
||||
|
||||
function TPasResolver.IsProcOverload(LastProc, CurProc: TPasProcedure): boolean;
|
||||
begin
|
||||
if msDelphi in TPasProcedureScope(LastProc.CustomData).ModeSwitches then
|
||||
begin
|
||||
if (not LastProc.IsOverload) or (not CurProc.IsOverload) then
|
||||
exit(false);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// mode objfpc
|
||||
if IsSameProcContext(LastProc.Parent,CurProc.Parent) then
|
||||
// mode objfpc: procs in same context have implicit overload
|
||||
else
|
||||
begin
|
||||
// mode objfpc, different context
|
||||
if not ProcHasGroupOverload(LastProc) then
|
||||
exit(false);
|
||||
end;
|
||||
end;
|
||||
|
||||
// check if previous found proc is override of found proc
|
||||
if IsProcOverride(CurProc,LastProc) then
|
||||
begin
|
||||
// previous found proc is override of found proc -> skip
|
||||
exit(false);
|
||||
end;
|
||||
|
||||
Result:=true;
|
||||
end;
|
||||
|
||||
function TPasResolver.FindProcSameSignature(const ProcName: string;
|
||||
Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
|
||||
): TPasProcedure;
|
||||
@ -10422,7 +10476,7 @@ begin
|
||||
if ProcNeedsParams(Proc.ProcType) and not ExprIsAddrTarget(El) then
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El));
|
||||
writeln('TPasResolver.ResolveNameExpr ',GetObjPath(El),' Args.Count=',Proc.ProcType.Args.Count);
|
||||
{$ENDIF}
|
||||
RaiseMsg(20170216152138,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,[Proc.Name],El);
|
||||
|
||||
@ -43,6 +43,7 @@ Type
|
||||
|
||||
// generic method
|
||||
Procedure TestGenericMethod_Program;
|
||||
Procedure TestGenericMethod_OverloadDelphi;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -384,6 +385,35 @@ begin
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGenericMethod_OverloadDelphi;
|
||||
begin
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure Fly<S>; overload;',
|
||||
' procedure Fly<T>(val: T); overload;',
|
||||
' end;',
|
||||
'procedure TObject.Fly<S>;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure TObject.Fly<T>(val: word);',
|
||||
'begin',
|
||||
'end;',
|
||||
'var o : TObject;',
|
||||
'begin',
|
||||
' o.Fly<word>;',
|
||||
' o.Fly<word>();',
|
||||
' o.Fly<longint>(3);',
|
||||
' with o do begin',
|
||||
' Fly<word>;',
|
||||
' Fly<word>();',
|
||||
' Fly<longint>(13);',
|
||||
' end;',
|
||||
'']);
|
||||
ParseModule;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTest(TTestGenerics);
|
||||
end.
|
||||
|
||||
@ -77,11 +77,11 @@ type
|
||||
procedure TestGenProc_Infer_Widen;
|
||||
procedure TestGenProc_Infer_PassAsArg;
|
||||
procedure TestGenProc_AnonymousProc;
|
||||
// ToDo: FuncName:= instead of Result:=
|
||||
|
||||
// generic methods
|
||||
procedure TestGenMethod_ImplicitSpec_ObjFPC;
|
||||
procedure TestGenMethod_Delphi;
|
||||
procedure TestGenMethod_Overload_Delphi;
|
||||
|
||||
// generic array
|
||||
procedure TestGen_Array_OtherUnit;
|
||||
@ -2501,6 +2501,59 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGenMethod_Overload_Delphi;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode delphi}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
' procedure Run<S>; overload;',
|
||||
' procedure Run<T>(w: word); overload;',
|
||||
' end; ',
|
||||
'procedure TObject.Run<S>;',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure TObject.Run<T>(w: word);',
|
||||
'begin',
|
||||
'end;',
|
||||
'var o: TObject;',
|
||||
'begin',
|
||||
' o.Run<word>;',
|
||||
' o.Run<word>();',
|
||||
' o.Run<longint>(3);',
|
||||
' with o do begin',
|
||||
' Run<word>;',
|
||||
' Run<word>();',
|
||||
' Run<longint>(13);',
|
||||
' end;',
|
||||
'']);
|
||||
ConvertProgram;
|
||||
CheckSource('TestGenMethod_Overload_Delphi',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createClass(this, "TObject", null, function () {',
|
||||
' this.$init = function () {',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' };',
|
||||
' this.Run$G1 = function () {',
|
||||
' };',
|
||||
' this.Run$1G1 = function (w) {',
|
||||
' };',
|
||||
'});',
|
||||
'this.o = null;',
|
||||
'']),
|
||||
LinesToStr([ // $mod.$main
|
||||
'$mod.o.Run$G1();',
|
||||
'$mod.o.Run$G1();',
|
||||
'$mod.o.Run$1G1(3);',
|
||||
'var $with = $mod.o;',
|
||||
'$with.Run$G1();',
|
||||
'$with.Run$G1();',
|
||||
'$with.Run$1G1(13);',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestGenerics.TestGen_Array_OtherUnit;
|
||||
begin
|
||||
WithTypeInfo:=true;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user