paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-13 12:09:21 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed searching forward proc in local scope

Browse Source
This commit is contained in:
mattias 2019-04-15 08:41:34 +00:00
parent a01249f56d
commit 7e240a4481
2 changed files with 38 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
compiler/packages/fcl-passrc/src/pasresolver.pp
View File

@ -1436,7 +1436,7 @@ type
FindProcData: Pointer; var Abort: boolean); virtual;
function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
Scope: TPasScope): TPasProcedure;
Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
protected
procedure SetCurrentParser(AValue: TPasParser); override;
procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
@ -4856,7 +4856,8 @@ begin
end;
function TPasResolver.FindProcSameSignature(const ProcName: string;
Proc: TPasProcedure; Scope: TPasScope): TPasProcedure;
Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
): TPasProcedure;
var
FindData: TFindProcData;
Abort: boolean;
@ -4866,7 +4867,10 @@ begin
FindData.Args:=Proc.ProcType.Args;
FindData.Kind:=fpkSameSignature;
Abort:=false;
Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort);
if OnlyLocal then
Scope.IterateLocalElements(ProcName,Scope,@OnFindProc,@FindData,Abort)
else
Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort);
Result:=FindData.Found;
end;
@ -5845,7 +5849,7 @@ var
DeclProc, Proc, ParentProc: TPasProcedure;
Abort, HasDots, IsClassConDestructor: boolean;
DeclProcScope, ProcScope: TPasProcedureScope;
ParentScope: TPasScope;
ParentScope: TPasIdentifierScope;
pm: TProcedureModifier;
ptm: TProcTypeModifier;
ObjKind: TPasObjKind;
@ -6052,13 +6056,15 @@ begin
if (ProcName<>'') and ProcNeedsBody(Proc) then
begin
// check if there is a forward declaration
ParentScope:=GetParentLocalScope;
//writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2]));
ParentScope:=GetParentLocalScope as TPasIdentifierScope;
//writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc));
DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope);
DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true);
//writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent));
//if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc));
if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
DeclProc:=FindProcSameSignature(ProcName,Proc,
(Proc.GetModule.InterfaceSection.CustomData) as TPasScope);
(Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true);
//writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
if (DeclProc<>nil) then
begin
@ -6285,7 +6291,7 @@ begin
else if ImplProc.ClassType=TPasClassDestructor then
DeclProc:=ClassOrRecScope.ClassDestructor
else
DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope);
DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
if DeclProc=nil then
RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
@ -8789,7 +8795,7 @@ begin
exit;
InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
end;
AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope);
AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
PopScope;
if AncestorProc=nil then
// 'inherited;' without ancestor DeclProc is silently ignored

23
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -409,6 +409,7 @@ type
Procedure TestProcOverloadBaseTypeOtherUnit;
Procedure TestProcOverloadBaseProcNoHint;
Procedure TestProcOverload_UnitOrderFail;
Procedure TestProcOverload_UnitSameSignature;
Procedure TestProcOverloadDelphiMissingNextOverload;
Procedure TestProcOverloadDelphiMissingPrevOverload;
Procedure TestProcOverloadDelphiUnit;
@ -6514,6 +6515,28 @@ begin
CheckResolverException(sIncompatibleTypeArgNo,nIncompatibleTypeArgNo);
end;
procedure TTestResolver.TestProcOverload_UnitSameSignature;
begin
AddModuleWithIntfImplSrc('unit1.pp',
LinesToStr([
'procedure Val(d: string);',
'']),
LinesToStr([
'procedure Val(d: string); begin end;',
'']));
StartProgram(true);
Add([
'uses unit1;',
'procedure Val(d: string);',
'begin',
'end;',
'var',
' s: string;',
'begin',
' Val(s);']);
ParseProgram;
end;
procedure TTestResolver.TestProcOverloadDelphiMissingNextOverload;
begin
StartProgram(false);