* if the unit of a procedure call is explicitly specified, limit the search

    for (overloaded) procsyms to that unit (mantis #17220)

git-svn-id: trunk@15887 -

.gitattributes

@@ -10632,6 +10632,8 @@ tests/webtbs/tw17180.pp svneol=native#text/plain
 tests/webtbs/tw17181.pp svneol=native#text/plain
 tests/webtbs/tw1720.pp svneol=native#text/plain
 tests/webtbs/tw17213.pp svneol=native#text/pascal
+tests/webtbs/tw17220.pp svneol=native#text/plain
+tests/webtbs/tw17220a.pp svneol=native#text/plain
 tests/webtbs/tw1735.pp svneol=native#text/plain
 tests/webtbs/tw1737.pp svneol=native#text/plain
 tests/webtbs/tw1744.pp svneol=native#text/plain
@@ -11489,6 +11491,8 @@ tests/webtbs/uw13583.pp svneol=native#text/plain
 tests/webtbs/uw14124.pp svneol=native#text/plain
 tests/webtbs/uw14958.pp svneol=native#text/plain
 tests/webtbs/uw15909.pp svneol=native#text/plain
+tests/webtbs/uw17220.pp svneol=native#text/plain
+tests/webtbs/uw17220a.pp svneol=native#text/plain
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw2266a.inc svneol=native#text/plain

compiler/htypechk.pas

@@ -67,11 +67,11 @@ interface
         FParaLength : smallint;
         FAllowVariant : boolean;
         procedure collect_overloads_in_class(ProcdefOverloadList:TFPObjectList);
-        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean);
-        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean);
+        procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
+        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
         function  proc_add(ps:tprocsym;pd:tprocdef;objcidcall: boolean):pcandidate;
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean);
+        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
         destructor destroy;override;
         procedure list(all:boolean);
@@ -1647,7 +1647,7 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall:boolean);
+    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -1655,7 +1655,7 @@ implementation
         FProcsym:=sym;
         FProcsymtable:=st;
         FParanode:=ppn;
-        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall);
+        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit);
       end;
 
 
@@ -1665,7 +1665,7 @@ implementation
         FProcsym:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
-        create_candidate_list(false,false,false);
+        create_candidate_list(false,false,false,false);
       end;
 
 
@@ -1722,7 +1722,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall: boolean);
+    procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
       var
         j          : integer;
         pd         : tprocdef;
@@ -1755,6 +1755,14 @@ implementation
         while assigned(checkstack) do
           begin
             srsymtable:=checkstack^.symtable;
+            { if the unit in which the routine has to be searched has been
+              specified explicitly, stop searching after its symtable(s) have
+              been checked (can be both the static and the global symtable
+              in case it's the current unit itself) }
+            if explicitunit and
+               (FProcsymtable.symtabletype in [globalsymtable,staticsymtable]) and
+               (srsymtable.moduleid<>FProcsymtable.moduleid) then
+              break;
             if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
               begin
                 srsym:=tprocsym(srsymtable.FindWithHash(hashedid));
@@ -1780,12 +1788,12 @@ implementation
                       break;
                   end;
               end;
-            checkstack:=checkstack^.next;
+            checkstack:=checkstack^.next
           end;
       end;
 
 
-    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall:boolean);
+    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
       var
         j     : integer;
         pd    : tprocdef;
@@ -1804,7 +1812,7 @@ implementation
            (FProcsym.owner.symtabletype=objectsymtable) then
           collect_overloads_in_class(ProcdefOverloadList)
         else
-          collect_overloads_in_units(ProcdefOverloadList,objcidcall);
+          collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);
 
         { determine length of parameter list.
           for operators also enable the variant-operators if

compiler/ncal.pas

@@ -48,7 +48,8 @@ interface
          cnf_uses_varargs,       { varargs are used in the declaration }
          cnf_create_failed,      { exception thrown in constructor -> don't call beforedestruction }
          cnf_objc_processed,     { the procedure name has been set to the appropriate objc_msgSend* variant -> don't process again }
-         cnf_objc_id_call        { the procedure is a member call via id -> any ObjC method of any ObjC type in scope is fair game }
+         cnf_objc_id_call,       { the procedure is a member call via id -> any ObjC method of any ObjC type in scope is fair game }
+         cnf_unit_specified      { the unit in which the procedure has to be searched has been specified }
        );
        tcallnodeflags = set of tcallnodeflag;
 
@@ -2650,7 +2651,7 @@ implementation
                   { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
                   ignorevisibility:=(nf_isproperty in flags) or
                                     ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
-                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags);
+                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags);
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are

compiler/pexpr.pas

@@ -1351,12 +1351,13 @@ implementation
        procedure factor_read_id(out p1:tnode;var again:boolean);
          var
            srsym : tsym;
-           unit_found : boolean;
            srsymtable : TSymtable;
            hdef  : tdef;
            orgstoredpattern,
            storedpattern : string;
+           callflags: tcallnodeflags;
            t : ttoken;
+           unit_found : boolean;
          begin
            { allow post fix operators }
            again:=true;
@@ -1622,10 +1623,16 @@ implementation
                           internalerror(2007012006);
                       end
                     else
-                      { regular procedure/function call }
-                      do_proc_call(srsym,srsymtable,nil,
-                                   (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
-                                   again,p1,[]);
+                      begin
+                        { regular procedure/function call }
+                        if not unit_found then
+                          callflags:=[]
+                        else
+                          callflags:=[cnf_unit_specified];
+                        do_proc_call(srsym,srsymtable,nil,
+                                     (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])),
+                                     again,p1,callflags);
+                      end;
                   end;
 
                 propertysym :

tests/webtbs/tw17220.pp

@@ -0,0 +1,14 @@
+program project1;
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+uses SysUtils, uw17220;
+
+var
+  A, B: int64;
+begin
+  writeln(uw17220.IntToHEX(16, 0)); {Here ERROR: called SysUtils.IntToHEX }
+  if uw17220.IntToHEX(16, 0)<>'passed' then
+    halt(1);
+end.
+

tests/webtbs/tw17220a.pp

@@ -0,0 +1,10 @@
+program project1;
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+uses uw17220a;
+
+begin
+  test;
+end.
+

tests/webtbs/uw17220.pp

@@ -0,0 +1,17 @@
+unit uw17220;
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+interface
+
+function IntToHEX(Value, Digits: int64): string; overload;
+
+implementation
+
+function IntToHEX(Value, Digits: int64): string;
+begin
+  IntToHEX := 'passed';
+end;
+
+end.
+

tests/webtbs/uw17220a.pp

@@ -0,0 +1,39 @@
+unit uw17220a;
+{$ifdef fpc}
+{$mode objfpc}{$H+}
+{$endif}
+interface
+
+uses
+  SysUtils;
+
+procedure test;
+function IntToHEX(Value, Digits: int64): string; overload;
+
+implementation
+
+function IntToHEX(Value, Digits: int64): string;
+begin
+  IntToHEX := 'passedq';
+end;
+
+function IntToHEX(Value, Digits: longint): string; overload;
+begin
+  IntToHEX := 'passedl';
+end;
+
+procedure test;
+  var
+    l: longint;
+    i: int64;
+  begin
+    l:=0;
+    i:=0;
+    if uw17220a.inttohex(l,l)<>'passedl' then
+      halt(1);
+    if uw17220a.inttohex(i,i)<>'passedq' then
+      halt(2);
+  end;
+
+end.
+