diff --git a/compiler/packages/fcl-passrc/src/pasresolver.pp b/compiler/packages/fcl-passrc/src/pasresolver.pp index 84d7bb3..7289977 100644 --- a/compiler/packages/fcl-passrc/src/pasresolver.pp +++ b/compiler/packages/fcl-passrc/src/pasresolver.pp @@ -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 diff --git a/compiler/packages/fcl-passrc/tests/tcresolver.pas b/compiler/packages/fcl-passrc/tests/tcresolver.pas index 12168c3..c25a19c 100644 --- a/compiler/packages/fcl-passrc/tests/tcresolver.pas +++ b/compiler/packages/fcl-passrc/tests/tcresolver.pas @@ -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);