paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-18 16:49:05 +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

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

@ -1436,7 +1436,7 @@ type
FindProcData: Pointer; var Abort: boolean); virtual; FindProcData: Pointer; var Abort: boolean); virtual;
function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean; function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean;
function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure; function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure;
Scope: TPasScope): TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure;
protected protected
procedure SetCurrentParser(AValue: TPasParser); override; procedure SetCurrentParser(AValue: TPasParser); override;
procedure ScannerWarnDirective(Sender: TObject; Identifier: string; procedure ScannerWarnDirective(Sender: TObject; Identifier: string;
@ -4856,7 +4856,8 @@ begin
end; end;
function TPasResolver.FindProcSameSignature(const ProcName: string; function TPasResolver.FindProcSameSignature(const ProcName: string;
Proc: TPasProcedure; Scope: TPasScope): TPasProcedure; Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean
): TPasProcedure;
var var
FindData: TFindProcData; FindData: TFindProcData;
Abort: boolean; Abort: boolean;
@ -4866,6 +4867,9 @@ begin
FindData.Args:=Proc.ProcType.Args; FindData.Args:=Proc.ProcType.Args;
FindData.Kind:=fpkSameSignature; FindData.Kind:=fpkSameSignature;
Abort:=false; Abort:=false;
if OnlyLocal then
Scope.IterateLocalElements(ProcName,Scope,@OnFindProc,@FindData,Abort)
else
Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort); Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort);
Result:=FindData.Found; Result:=FindData.Found;
end; end;
@ -5845,7 +5849,7 @@ var
DeclProc, Proc, ParentProc: TPasProcedure; DeclProc, Proc, ParentProc: TPasProcedure;
Abort, HasDots, IsClassConDestructor: boolean; Abort, HasDots, IsClassConDestructor: boolean;
DeclProcScope, ProcScope: TPasProcedureScope; DeclProcScope, ProcScope: TPasProcedureScope;
ParentScope: TPasScope; ParentScope: TPasIdentifierScope;
pm: TProcedureModifier; pm: TProcedureModifier;
ptm: TProcTypeModifier; ptm: TProcTypeModifier;
ObjKind: TPasObjKind; ObjKind: TPasObjKind;
@ -6052,13 +6056,15 @@ begin
if (ProcName<>'') and ProcNeedsBody(Proc) then if (ProcName<>'') and ProcNeedsBody(Proc) then
begin begin
// check if there is a forward declaration // 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)); //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)); //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 if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then
DeclProc:=FindProcSameSignature(ProcName,Proc, 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)); //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc));
if (DeclProc<>nil) then if (DeclProc<>nil) then
begin begin
@ -6285,7 +6291,7 @@ begin
else if ImplProc.ClassType=TPasClassDestructor then else if ImplProc.ClassType=TPasClassDestructor then
DeclProc:=ClassOrRecScope.ClassDestructor DeclProc:=ClassOrRecScope.ClassDestructor
else else
DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope); DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false);
if DeclProc=nil then if DeclProc=nil then
RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType); RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType);
DeclProcScope:=DeclProc.CustomData as TPasProcedureScope; DeclProcScope:=DeclProc.CustomData as TPasProcedureScope;
@ -8789,7 +8795,7 @@ begin
exit; exit;
InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil); InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil);
end; end;
AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope); AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false);
PopScope; PopScope;
if AncestorProc=nil then if AncestorProc=nil then
// 'inherited;' without ancestor DeclProc is silently ignored // '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 TestProcOverloadBaseTypeOtherUnit;
Procedure TestProcOverloadBaseProcNoHint; Procedure TestProcOverloadBaseProcNoHint;
Procedure TestProcOverload_UnitOrderFail; Procedure TestProcOverload_UnitOrderFail;
Procedure TestProcOverload_UnitSameSignature;
Procedure TestProcOverloadDelphiMissingNextOverload; Procedure TestProcOverloadDelphiMissingNextOverload;
Procedure TestProcOverloadDelphiMissingPrevOverload; Procedure TestProcOverloadDelphiMissingPrevOverload;
Procedure TestProcOverloadDelphiUnit; Procedure TestProcOverloadDelphiUnit;
@ -6514,6 +6515,28 @@ begin
CheckResolverException(sIncompatibleTypeArgNo,nIncompatibleTypeArgNo); CheckResolverException(sIncompatibleTypeArgNo,nIncompatibleTypeArgNo);
end; 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; procedure TTestResolver.TestProcOverloadDelphiMissingNextOverload;
begin begin
StartProgram(false); StartProgram(false);