* refactor is_visible_for_object

git-svn-id: trunk@12152 -

compiler/htypechk.pas

@@ -1781,7 +1781,7 @@ implementation
                (
                 ignorevisibility or
                 (pd.owner.symtabletype<>objectsymtable) or
-                pd.is_visible_for_object(contextobjdef,nil)
+                is_visible_for_object(pd,contextobjdef)
                ) then
               begin
                 { don't add duplicates, only compare visible parameters for the user }

compiler/nobj.pas

@@ -210,7 +210,7 @@ implementation
         new(procdefcoll);
         procdefcoll^.data:=pd;
         procdefcoll^.hidden:=false;
-        procdefcoll^.visible:=pd.is_visible_for_object(_class,nil);
+        procdefcoll^.visible:=is_visible_for_object(pd,_class);
         VMTSymEntry.ProcdefList.Add(procdefcoll);
 
         { Register virtual method and give it a number }
@@ -252,7 +252,7 @@ implementation
           procdefs, because they can be reused in the next class.
           The check to skip the invisible methods that are in the
           list is futher down in the code }
-        is_visible:=pd.is_visible_for_object(_class,nil);
+        is_visible:=is_visible_for_object(pd,_class);
         { Load other values for easier readability }
         hasoverloads:=(tprocsym(pd.procsym).ProcdefList.Count>1);
         pdoverload:=(po_overload in pd.procoptions);

compiler/pinline.pas

@@ -430,7 +430,7 @@ implementation
             { search the constructor also in the symbol tables of
               the parents }
             afterassignment:=false;
-            searchsym_in_class(classh,nil,pattern,srsym,srsymtable);
+            searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
             consume(_ID);
             do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
             { we need to know which procedure is called }

compiler/symdef.pas

@@ -487,7 +487,6 @@ interface
           function  cplusplusmangledname : string;
           function  is_methodpointer:boolean;override;
           function  is_addressonly:boolean;override;
-          function  is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean;
        end;
 
        { single linked list of overloaded procs }
@@ -3177,60 +3176,6 @@ implementation
       end;
 
 
-    function tprocdef.is_visible_for_object(currobjdef,contextobjdef:tobjectdef):boolean;
-      var
-        contextst : TSymtable;
-      begin
-        result:=false;
-
-        { Support passing a context in which module we are to find protected members }
-        if assigned(contextobjdef) then
-          contextst:=contextobjdef.owner
-        else
-          contextst:=nil;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (visibility=vis_private) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           not(owner.defowner.owner.iscurrentunit or (owner.defowner.owner=contextst)) then
-          exit;
-
-        if (visibility=vis_strictprivate) then
-          begin
-            result:=currobjdef=tobjectdef(owner.defowner);
-            exit;
-          end;
-
-        if (visibility=vis_strictprotected) then
-          begin
-             result:=assigned(currobjdef) and
-               currobjdef.is_related(tobjectdef(owner.defowner));
-             exit;
-          end;
-
-        { protected symbols are visible in the module that defines them and
-          also visible to related objects. The related object must be defined
-          in the current module }
-        if (visibility=vis_protected) and
-           (
-            (
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             not((owner.defowner.owner.iscurrentunit) or (owner.defowner.owner=contextst))
-            ) and
-            not(
-                assigned(currobjdef) and
-                (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                (currobjdef.owner.iscurrentunit) and
-                currobjdef.is_related(tobjectdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        result:=true;
-      end;
-
-
     function tprocdef.GetSymtable(t:tGetSymtable):TSymtable;
       begin
         case t of

compiler/symsym.pas

@@ -99,9 +99,6 @@ interface
           function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef;
           function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
-          { currobjdef is the object def to assume, this is necessary for protected and
-            private, context is the object def we're really in, this is for the strict stuff }
-          function is_visible_for_object(currobjdef:tdef;context:tdef):boolean;override;
           property ProcdefList:TFPObjectList read FProcdefList;
        end;
 
@@ -752,27 +749,6 @@ implementation
       end;
 
 
-    function tprocsym.is_visible_for_object(currobjdef:tdef;context:tdef):boolean;
-      var
-        i  : longint;
-        pd : tprocdef;
-      begin
-        { This procsym is visible, when there is at least
-          one of the procdefs visible }
-        result:=false;
-        for i:=0 to ProcdefList.Count-1 do
-          begin
-            pd:=tprocdef(ProcdefList[i]);
-            if (pd.owner=owner) and
-                pd.is_visible_for_object(tobjectdef(currobjdef),tobjectdef(context)) then
-              begin
-                result:=true;
-                exit;
-              end;
-          end;
-      end;
-
-
 {****************************************************************************
                                   TERRORSYM
 ****************************************************************************}

compiler/symtable.pas

@@ -190,6 +190,9 @@ interface
 
 {*** Search ***}
     procedure addsymref(sym:tsym);
+    function  is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+    function  is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
+    function  is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
@@ -1094,8 +1097,9 @@ implementation
               hsym:=search_class_member(tobjectdef(defowner),hashedid.id);
               if assigned(hsym) and
                  (
-                  (not(m_delphi in current_settings.modeswitches) and
+                  (
-                   tsym(hsym).is_visible_for_object(tobjectdef(defowner),tobjectdef(defowner))
+                   not(m_delphi in current_settings.modeswitches) and
+                   is_visible_for_object(hsym,tobjectdef(defowner))
                   ) or
                   (
                    { In Delphi, you can repeat members of a parent class. You can't }
@@ -1537,11 +1541,95 @@ implementation
        end;
 
 
+    function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+      var
+        symownerdef : tobjectdef;
+      begin
+        result:=false;
+
+        { Get objdectdef owner of the symtable for the is_related checks }
+        if not assigned(symst) or
+           (symst.symtabletype<>objectsymtable) then
+          internalerror(200810285);
+        symownerdef:=tobjectdef(symst.defowner);
+        case symvisibility of
+          vis_private :
+            begin
+              { private symbols are allowed when we are in the same
+                module as they are defined }
+              result:=(symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                      (symownerdef.owner.iscurrentunit);
+            end;
+          vis_strictprivate :
+            begin
+              result:=assigned(current_objectdef) and
+                      (current_objectdef=symownerdef);
+            end;
+          vis_strictprotected :
+            begin
+               result:=assigned(current_objectdef) and
+                       current_objectdef.is_related(symownerdef);
+            end;
+          vis_protected :
+            begin
+              { protected symbols are visible in the module that defines them and
+                also visible to related objects. The related object must be defined
+                in the current module }
+              result:=(
+                       (
+                        (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                        (symownerdef.owner.iscurrentunit)
+                       ) or
+                       (
+                        assigned(contextobjdef) and
+                        (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                        (contextobjdef.owner.iscurrentunit) and
+                        contextobjdef.is_related(symownerdef)
+                       )
+                      );
+            end;
+          vis_public,
+          vis_published :
+            result:=true;
+        end;
+      end;
+
+
+    function is_visible_for_object(pd:tprocdef;contextobjdef:tobjectdef):boolean;
+      begin
+        result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef);
+      end;
+
+
+    function is_visible_for_object(sym:tsym;contextobjdef:tobjectdef):boolean;
+      var
+        i  : longint;
+        pd : tprocdef;
+      begin
+        if sym.typ=procsym then
+          begin
+            { A procsym is visible, when there is at least one of the procdefs visible }
+            result:=false;
+            for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
+              begin
+                pd:=tprocdef(tprocsym(sym).ProcdefList[i]);
+                if (pd.owner=sym.owner) and
+                   is_visible_for_object(pd,contextobjdef) then
+                  begin
+                    result:=true;
+                    exit;
+                  end;
+              end;
+          end
+        else
+          result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef);
+      end;
+
+
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
         hashedid   : THashedIDString;
-        topclass   : tobjectdef;
+        contextobjdef : tobjectdef;
-        context    : tobjectdef;
         stackitem  : psymtablestackitem;
       begin
         result:=false;
@@ -1553,7 +1641,6 @@ implementation
             srsym:=tsym(srsymtable.FindWithHash(hashedid));
             if assigned(srsym) then
               begin
-                topclass:=nil;
                 { use the class from withsymtable only when it is
                   defined in this unit }
                 if (srsymtable.symtabletype=withsymtable) and
@@ -1561,11 +1648,11 @@ implementation
                    (srsymtable.defowner.typ=objectdef) and
                    (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
                    (srsymtable.defowner.owner.iscurrentunit) then
-                  topclass:=tobjectdef(srsymtable.defowner)
+                  contextobjdef:=tobjectdef(srsymtable.defowner)
                 else
-                  topclass:=current_objectdef;
+                  contextobjdef:=current_objectdef;
-                context:=current_objectdef;
+                if (srsym.owner.symtabletype<>objectsymtable) or
-                if tsym(srsym).is_visible_for_object(topclass,context) then
+                   is_visible_for_object(srsym,contextobjdef) then
                   begin
                     { we need to know if a procedure references symbols
                       in the static symtable, because then it can't be
@@ -1614,8 +1701,10 @@ implementation
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
                    not(srsym.typ in [fieldvarsym,paravarsym]) and
-                   (not assigned(current_objectdef) or
+                   (
-                    tsym(srsym).is_visible_for_object(current_objectdef,current_objectdef)) then
+                    (srsym.owner.symtabletype<>objectsymtable) or
+                    is_visible_for_object(srsym,current_objectdef)
+                   ) then
                   begin
                     { we need to know if a procedure references symbols
                       in the static symtable, because then it can't be
@@ -1674,8 +1763,14 @@ implementation
 
     function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       var
-        hashedid      : THashedIDString;
+        hashedid : THashedIDString;
       begin
+        { The contextclassh is used for visibility. The classh must be equal to
+          or be a parent of contextclassh. E.g. for inherited searches the classh is the
+          parent. }
+        if assigned(classh) and
+           not contextclassh.is_related(classh) then
+          internalerror(200811161);
         result:=false;
         hashedid.id:=s;
         while assigned(classh) do
@@ -1683,7 +1778,7 @@ implementation
             srsymtable:=classh.symtable;
             srsym:=tsym(srsymtable.FindWithHash(hashedid));
             if assigned(srsym) and
-               tsym(srsym).is_visible_for_object(contextclassh,current_objectdef) then
+               is_visible_for_object(srsym,contextclassh) then
               begin
                 addsymref(srsym);
                 result:=true;

compiler/symtype.pas

@@ -106,11 +106,6 @@ interface
          function  mangledname:string; virtual;
          procedure buildderef;virtual;
          procedure deref;virtual;
-         { currobjdef is the object def to assume, this is necessary for protected and
-           private,
-           context is the object def we're really in, this is for the strict stuff
-         }
-         function is_visible_for_object(currobjdef:tdef;context : tdef):boolean;virtual;
          procedure ChangeOwner(st:TSymtable);
          procedure IncRefCount;
          procedure IncRefCountBy(AValue : longint);
@@ -388,58 +383,8 @@ implementation
       end;
 
 
-    function tsym.is_visible_for_object(currobjdef:Tdef;context : tdef):boolean;
-      begin
-        is_visible_for_object:=false;
-
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        if (visibility=vis_private) and
-           assigned(owner.defowner) and
-           (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-           (not owner.defowner.owner.iscurrentunit) then
-          exit;
-
-        if (visibility=vis_strictprivate) then
-          begin
-            result:=assigned(currobjdef) and
-              (context=tdef(owner.defowner));
-            exit;
-          end;
-
-        if (visibility=vis_strictprotected) then
-          begin
-            result:=assigned(context) and
-              context.is_related(tdef(owner.defowner));
-            exit;
-          end;
-
-        { protected symbols are visible in the module that defines them and
-          also visible to related objects }
-        if (visibility=vis_protected) and
-           (
-            (
-             assigned(owner.defowner) and
-             (owner.defowner.owner.symtabletype in [globalsymtable,staticsymtable]) and
-             (not owner.defowner.owner.iscurrentunit)
-            ) and
-            not(
-                assigned(currobjdef) and
-                (currobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
-                (currobjdef.owner.iscurrentunit) and
-                currobjdef.is_related(tdef(owner.defowner))
-               )
-           ) then
-          exit;
-
-        is_visible_for_object:=true;
-      end;
-
-
     procedure tsym.ChangeOwner(st:TSymtable);
       begin
-//        if assigned(Owner) then
-//          Owner.SymList.List.List^[i].Data:=nil;
         Owner:=st;
         inherited ChangeOwner(Owner.SymList);
       end;