* removed is_visible_for_proc

  * search also for class overloads when finding interface
    implementations

compiler/ncal.pas

@@ -285,48 +285,6 @@ type
       end;
 
 
-    procedure search_class_overloads(aprocsym : tprocsym);
-    { searches n in symtable of pd and all anchestors }
-      var
-        speedvalue : cardinal;
-        srsym      : tprocsym;
-        s          : string;
-        objdef     : tobjectdef;
-      begin
-        if aprocsym.overloadchecked then
-         exit;
-        aprocsym.overloadchecked:=true;
-        if (aprocsym.owner.symtabletype<>objectsymtable) then
-         internalerror(200111021);
-        objdef:=tobjectdef(aprocsym.owner.defowner);
-        { we start in the parent }
-        if not assigned(objdef.childof) then
-         exit;
-        objdef:=objdef.childof;
-        s:=aprocsym.name;
-        speedvalue:=getspeedvalue(s);
-        while assigned(objdef) do
-         begin
-           srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
-           if assigned(srsym) then
-            begin
-              if (srsym.typ<>procsym) then
-               internalerror(200111022);
-              if srsym.is_visible_for_proc(current_procinfo.procdef) then
-               begin
-                 srsym.add_para_match_to(Aprocsym);
-                 { we can stop if the overloads were already added
-                  for the found symbol }
-                 if srsym.overloadchecked then
-                  break;
-               end;
-            end;
-           { next parent }
-           objdef:=objdef.childof;
-         end;
-      end;
-
-
       function is_better_candidate(currpd,bestpd:pcandidate):integer;
         var
           res : integer;
@@ -2612,7 +2570,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.195  2003-10-09 21:31:37  daniel
+  Revision 1.196  2003-10-13 14:05:12  peter
+    * removed is_visible_for_proc
+    * search also for class overloads when finding interface
+      implementations
+
+  Revision 1.195  2003/10/09 21:31:37  daniel
     * Register allocator splitted, ans abstract now
 
   Revision 1.194  2003/10/09 15:00:13  florian

compiler/nobj.pas

@@ -1036,60 +1036,72 @@ implementation
 
     function tclassheader.gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
       var
-        sym: tprocsym;
+        sym: tsym;
         implprocdef : Tprocdef;
         i: cardinal;
       begin
         gintfgetcprocdef:=nil;
-        sym:=tprocsym(search_class_member(_class,name));
-        if assigned(sym) and (sym.typ=procsym) then
-          for i:=1 to sym.procdef_count do
-            begin
-              implprocdef:=sym.procdef[i];
-              if (compare_paras(proc.para,implprocdef.para,cp_none,false,false)>=te_equal) and
-                 (proc.proccalloption=implprocdef.proccalloption) then
-                begin
-                  gintfgetcprocdef:=implprocdef;
-                  exit;
-                end;
-            end;
+
+        sym:=tsym(search_class_member(_class,name));
+        if assigned(sym) and
+           (sym.typ=procsym) then
+          begin
+            { when the definition has overload directive set, we search for
+              overloaded definitions in the class, this only needs to be done once
+              for class entries as the tree keeps always the same }
+            if (not tprocsym(sym).overloadchecked) and
+               (po_overload in tprocsym(sym).first_procdef.procoptions) and
+               (tprocsym(sym).owner.symtabletype=objectsymtable) then
+             search_class_overloads(tprocsym(sym));
+
+            for i:=1 to tprocsym(sym).procdef_count do
+              begin
+                implprocdef:=tprocsym(sym).procdef[i];
+                if (compare_paras(proc.para,implprocdef.para,cp_none,false,false)>=te_equal) and
+                   (proc.proccalloption=implprocdef.proccalloption) then
+                  begin
+                    gintfgetcprocdef:=implprocdef;
+                    exit;
+                  end;
+              end;
+          end;
       end;
 
 
     procedure tclassheader.gintfdoonintf(intf: tobjectdef; intfindex: longint);
       var
-        i: longint;
-        proc: tprocdef;
+        def: tdef;
         procname: string; { for error }
         mappedname: string;
         nextexist: pointer;
         implprocdef: tprocdef;
       begin
-        for i:=1 to intf.symtable.defindex.count do
+        def:=tdef(intf.symtable.defindex.first);
+        while assigned(def) do
           begin
-            proc:=tprocdef(intf.symtable.defindex.search(i));
-            if proc.deftype=procdef then
+            if def.deftype=procdef then
               begin
                 procname:='';
                 implprocdef:=nil;
                 nextexist:=nil;
                 repeat
-                  mappedname:=_class.implementedinterfaces.getmappings(intfindex,proc.procsym.name,nextexist);
+                  mappedname:=_class.implementedinterfaces.getmappings(intfindex,tprocdef(def).procsym.name,nextexist);
                   if procname='' then
-                    procname:=proc.procsym.name;
+                    procname:=tprocdef(def).procsym.name;
                     //mappedname; { for error messages }
                   if mappedname<>'' then
-                    implprocdef:=gintfgetcprocdef(proc,mappedname);
+                    implprocdef:=gintfgetcprocdef(tprocdef(def),mappedname);
                 until assigned(implprocdef) or not assigned(nextexist);
                 if not assigned(implprocdef) then
-                  implprocdef:=gintfgetcprocdef(proc,proc.procsym.name);
+                  implprocdef:=gintfgetcprocdef(tprocdef(def),tprocdef(def).procsym.name);
                 if procname='' then
-                  procname:=proc.procsym.name;
+                  procname:=tprocdef(def).procsym.name;
                 if assigned(implprocdef) then
                   _class.implementedinterfaces.addimplproc(intfindex,implprocdef)
                 else
-                  Message1(sym_e_no_matching_implementation_found,proc.fullprocname(false));
+                  Message1(sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false));
               end;
+            def:=tdef(def.indexnext);
           end;
       end;
 
@@ -1356,7 +1368,12 @@ initialization
 end.
 {
   $Log$
-  Revision 1.52  2003-10-10 17:48:13  peter
+  Revision 1.53  2003-10-13 14:05:12  peter
+    * removed is_visible_for_proc
+    * search also for class overloads when finding interface
+      implementations
+
+  Revision 1.52  2003/10/10 17:48:13  peter
     * old trgobj moved to x86/rgcpu and renamed to trgx86fpu
     * tregisteralloctor renamed to trgobj
     * removed rgobj from a lot of units

compiler/symdef.pas

@@ -555,7 +555,6 @@ interface
           function  cplusplusmangledname : string;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
-//          function  is_visible_for_proc(currprocdef:tprocdef):boolean;
           function  is_visible_for_object(currobjdef:tobjectdef):boolean;
           { debug }
 {$ifdef GDB}
@@ -3731,39 +3730,6 @@ implementation
       end;
 
 
-(*
-    function tprocdef.is_visible_for_proc(currprocdef:tprocdef):boolean;
-      begin
-        is_visible_for_proc:=false;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (sp_private in symoptions) and
-           assigned(owner.defowner) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (owner.defowner.owner.unitid<>0) then
-          exit;
-
-        { protected symbols are vissible in the module that defines them and
-          also visible to related objects }
-        if (sp_protected in symoptions) and
-           (
-            (
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (owner.defowner.owner.unitid<>0)
-            ) and
-            not(
-                assigned(currprocdef) and
-                assigned(currprocdef._class) and
-                currprocdef._class.is_related(tobjectdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        is_visible_for_proc:=true;
-      end;
-*)
-
     function tprocdef.is_visible_for_object(currobjdef:tobjectdef):boolean;
       begin
         is_visible_for_object:=false;
@@ -5924,7 +5890,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.177  2003-10-11 16:06:42  florian
+  Revision 1.178  2003-10-13 14:05:12  peter
+    * removed is_visible_for_proc
+    * search also for class overloads when finding interface
+      implementations
+
+  Revision 1.177  2003/10/11 16:06:42  florian
     * fixed some MMX<->SSE
     * started to fix ppc, needs an overhaul
     + stabs info improve for spilling, not sure if it works correctly/completly

compiler/symsym.pas

@@ -70,7 +70,6 @@ interface
 {$endif GDB}
           procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
-          function  is_visible_for_proc(currprocdef:tprocdef):boolean;
           function  is_visible_for_object(currobjdef:tobjectdef):boolean;
           function  mangledname : string;
           procedure generate_mangledname;virtual;abstract;
@@ -570,39 +569,6 @@ implementation
 {$endif GDB}
 
 
-    function tstoredsym.is_visible_for_proc(currprocdef:tprocdef):boolean;
-      begin
-        is_visible_for_proc:=false;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (sp_private in symoptions) and
-           assigned(owner.defowner) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (owner.defowner.owner.unitid<>0) then
-          exit;
-
-        { protected symbols are vissible in the module that defines them and
-          also visible to related objects }
-        if (sp_protected in symoptions) and
-           (
-            (
-             assigned(owner.defowner) and
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (owner.defowner.owner.unitid<>0)
-            ) and
-            not(
-                assigned(currprocdef) and
-                assigned(currprocdef._class) and
-                currprocdef._class.is_related(tobjectdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        is_visible_for_proc:=true;
-      end;
-
-
     function tstoredsym.is_visible_for_object(currobjdef:tobjectdef):boolean;
       begin
         is_visible_for_object:=false;
@@ -2676,7 +2642,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.125  2003-10-08 19:19:45  peter
+  Revision 1.126  2003-10-13 14:05:12  peter
+    * removed is_visible_for_proc
+    * search also for class overloads when finding interface
+      implementations
+
+  Revision 1.125  2003/10/08 19:19:45  peter
     * set_varstate cleanup
 
   Revision 1.124  2003/10/07 21:14:33  peter

compiler/symtable.pas

@@ -209,6 +209,7 @@ interface
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
 
 {*** Object Helpers ***}
+    procedure search_class_overloads(aprocsym : tprocsym);
     function search_default_property(pd : tobjectdef) : tpropertysym;
 
 {*** symtable stack ***}
@@ -1778,7 +1779,7 @@ implementation
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
               if assigned(srsym) and
                  (not assigned(current_procinfo) or
-                  tstoredsym(srsym).is_visible_for_proc(current_procinfo.procdef)) then
+                  tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
                begin
                  searchsym:=true;
                  exit;
@@ -1809,7 +1810,7 @@ implementation
                   srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
                   if assigned(srsym) and
                      (not assigned(current_procinfo) or
-                      tstoredsym(srsym).is_visible_for_proc(current_procinfo.procdef)) then
+                      tstoredsym(srsym).is_visible_for_object(current_procinfo.procdef._class)) then
                     begin
                       result:=true;
                       exit;
@@ -1865,25 +1866,19 @@ implementation
             (classh.owner.unitid=0) then
            topclassh:=classh
          else
-           topclassh:=nil;
+           begin
+             if assigned(current_procinfo) then
+               topclassh:=current_procinfo.procdef._class
+             else
+               topclassh:=nil;
+           end;
          sym:=nil;
          while assigned(classh) do
           begin
             sym:=tsym(classh.symtable.speedsearch(s,speedvalue));
-            if assigned(sym) then
-             begin
-               if assigned(topclassh) then
-                begin
-                  if tstoredsym(sym).is_visible_for_object(topclassh) then
-                   break;
-                end
-               else
-                begin
-                  if (not assigned(current_procinfo) or
-                      tstoredsym(sym).is_visible_for_proc(current_procinfo.procdef)) then
-                   break;
-                end;
-             end;
+            if assigned(sym) and
+               tstoredsym(sym).is_visible_for_object(topclassh) then
+              break;
             classh:=classh.childof;
           end;
          searchsym_in_class:=sym;
@@ -2086,24 +2081,65 @@ implementation
                               Object Helpers
 ****************************************************************************}
 
-   var
-      _defaultprop : tpropertysym;
+    procedure search_class_overloads(aprocsym : tprocsym);
+    { searches n in symtable of pd and all anchestors }
+      var
+        speedvalue : cardinal;
+        srsym      : tprocsym;
+        s          : string;
+        objdef     : tobjectdef;
+      begin
+        if aprocsym.overloadchecked then
+         exit;
+        aprocsym.overloadchecked:=true;
+        if (aprocsym.owner.symtabletype<>objectsymtable) then
+         internalerror(200111021);
+        objdef:=tobjectdef(aprocsym.owner.defowner);
+        { we start in the parent }
+        if not assigned(objdef.childof) then
+         exit;
+        objdef:=objdef.childof;
+        s:=aprocsym.name;
+        speedvalue:=getspeedvalue(s);
+        while assigned(objdef) do
+         begin
+           srsym:=tprocsym(objdef.symtable.speedsearch(s,speedvalue));
+           if assigned(srsym) then
+            begin
+              if (srsym.typ<>procsym) then
+               internalerror(200111022);
+              if srsym.is_visible_for_object(tobjectdef(aprocsym.owner.defowner)) then
+               begin
+                 srsym.add_para_match_to(Aprocsym);
+                 { we can stop if the overloads were already added
+                  for the found symbol }
+                 if srsym.overloadchecked then
+                  break;
+               end;
+            end;
+           { next parent }
+           objdef:=objdef.childof;
+         end;
+      end;
+
 
    procedure tstoredsymtable.testfordefaultproperty(p : TNamedIndexItem;arg:pointer);
      begin
         if (tsym(p).typ=propertysym) and
            (ppo_defaultproperty in tpropertysym(p).propoptions) then
-          _defaultprop:=tpropertysym(p);
+          ppointer(arg)^:=p;
      end;
 
 
    function search_default_property(pd : tobjectdef) : tpropertysym;
    { returns the default property of a class, searches also anchestors }
+     var
+       _defaultprop : tpropertysym;
      begin
         _defaultprop:=nil;
         while assigned(pd) do
           begin
-             pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,nil);
+             pd.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);
              if assigned(_defaultprop) then
                break;
              pd:=pd.childof;
@@ -2256,7 +2292,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.114  2003-10-07 15:17:07  peter
+  Revision 1.115  2003-10-13 14:05:12  peter
+    * removed is_visible_for_proc
+    * search also for class overloads when finding interface
+      implementations
+
+  Revision 1.114  2003/10/07 15:17:07  peter
     * inline supported again, LOC_REFERENCEs are used to pass the
       parameters
     * inlineparasymtable,inlinelocalsymtable removed