fcl-passrc: fixed searching forward proc in local scope

git-svn-id: trunk@41872 -

packages/fcl-passrc/src/pasresolver.pp

@@ -1443,7 +1443,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;
@@ -4871,7 +4871,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;
@@ -4881,7 +4882,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;
 
@@ -5860,7 +5864,7 @@ var
   DeclProc, Proc, ParentProc: TPasProcedure;
   Abort, HasDots, IsClassConDestructor: boolean;
   DeclProcScope, ProcScope: TPasProcedureScope;
-  ParentScope: TPasScope;
+  ParentScope: TPasIdentifierScope;
   pm: TProcedureModifier;
   ptm: TProcTypeModifier;
   ObjKind: TPasObjKind;
@@ -6100,13 +6104,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
@@ -6333,7 +6339,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;
@@ -9004,7 +9010,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

packages/fcl-passrc/tests/tcresolver.pas

@@ -410,6 +410,7 @@ type
     Procedure TestProcOverloadBaseTypeOtherUnit;
     Procedure TestProcOverloadBaseProcNoHint;
     Procedure TestProcOverload_UnitOrderFail;
+    Procedure TestProcOverload_UnitSameSignature;
     Procedure TestProcOverloadDelphiMissingNextOverload;
     Procedure TestProcOverloadDelphiMissingPrevOverload;
     Procedure TestProcOverloadDelphiUnit;
@@ -6626,6 +6627,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);