Browse Source

* fixed visibility for procsyms
* fixed override check when there was no entry yet

peter 21 năm trước cách đây
mục cha
commit
6ffca1688e
4 tập tin đã thay đổi với 105 bổ sung53 xóa
  1. 33 26
      compiler/htypechk.pas
  2. 36 24
      compiler/nobj.pas
  3. 30 1
      compiler/symsym.pas
  4. 6 2
      compiler/symtype.pas

+ 33 - 26
compiler/htypechk.pas

@@ -1326,39 +1326,42 @@ implementation
                if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then
                 begin
                   srprocsym:=tprocsym(srsymtable.speedsearch(sym.name,sym.speedvalue));
-                  { process only visible procsyms }
                   if assigned(srprocsym) and
-                     (srprocsym.typ=procsym) and
-                     srprocsym.is_visible_for_object(topclassh) then
+                     (srprocsym.typ=procsym) then
                    begin
-                     { if this procedure doesn't have overload we can stop
+                     { if this visible procedure doesn't have overload we can stop
                        searching }
-                     if not(po_overload in srprocsym.first_procdef.procoptions) then
+                     if not(po_overload in srprocsym.first_procdef.procoptions) and
+                        srprocsym.first_procdef.is_visible_for_object(topclassh) then
                       break;
                      { process all overloaded definitions }
                      for j:=1 to srprocsym.procdef_count do
                       begin
                         pd:=srprocsym.procdef[j];
-                        { only when the # of parameter are supported by the
-                          procedure }
-                        if (FParalength>=pd.minparacount) and
-                           ((po_varargs in pd.procoptions) or { varargs }
-                           (FParalength<=pd.maxparacount)) then
-                         begin
-                           found:=false;
-                           hp:=FProcs;
-                           while assigned(hp) do
-                            begin
-                              { Only compare visible parameters for the user }
-                              if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
-                               begin
-                                 found:=true;
-                                 break;
-                               end;
-                              hp:=hp^.next;
-                            end;
-                           if not found then
-                             proc_add(pd);
+                        { only visible procedures need to be added }
+                        if pd.is_visible_for_object(topclassh) then
+                          begin
+                            { only when the # of parameter are supported by the
+                              procedure }
+                            if (FParalength>=pd.minparacount) and
+                               ((po_varargs in pd.procoptions) or { varargs }
+                               (FParalength<=pd.maxparacount)) then
+                             begin
+                               found:=false;
+                               hp:=FProcs;
+                               while assigned(hp) do
+                                begin
+                                  { Only compare visible parameters for the user }
+                                  if compare_paras(hp^.data.para,pd.para,cp_value_equal_const,[cpo_ignorehidden])>=te_equal then
+                                   begin
+                                     found:=true;
+                                     break;
+                                   end;
+                                  hp:=hp^.next;
+                                end;
+                               if not found then
+                                 proc_add(pd);
+                             end;
                          end;
                       end;
                    end;
@@ -1922,7 +1925,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.99  2004-10-08 17:09:43  peter
+  Revision 1.100  2004-10-12 14:34:49  peter
+    * fixed visibility for procsyms
+    * fixed override check when there was no entry yet
+
+  Revision 1.99  2004/10/08 17:09:43  peter
     * tvarsym.varregable added, split vo_regable from varoptions
 
   Revision 1.98  2004/09/27 15:15:52  peter

+ 36 - 24
compiler/nobj.pas

@@ -95,7 +95,7 @@ interface
         has_constructor,
         has_virtual_method : boolean;
         procedure newdefentry(vmtentry:pvmtentry;pd:tprocdef;is_visible:boolean);
-        procedure newvmtentry(sym:tprocsym;is_visible:boolean);
+        function  newvmtentry(sym:tprocsym):pvmtentry;
         procedure eachsym(sym : tnamedindexitem;arg:pointer);
         procedure disposevmttree;
         procedure writevirtualmethods(List:TAAsmoutput);
@@ -549,22 +549,15 @@ implementation
       end;
 
 
-    procedure tclassheader.newvmtentry(sym:tprocsym;is_visible:boolean);
-      var
-        i : cardinal;
-        vmtentry : pvmtentry;
+    function tclassheader.newvmtentry(sym:tprocsym):pvmtentry;
       begin
         { generate new vmtentry }
-        new(vmtentry);
-        vmtentry^.speedvalue:=sym.speedvalue;
-        vmtentry^.name:=stringdup(sym.name);
-        vmtentry^.next:=firstvmtentry;
-        vmtentry^.firstprocdef:=nil;
-        firstvmtentry:=vmtentry;
-
-        { inserts all definitions }
-        for i:=1 to sym.procdef_count do
-          newdefentry(vmtentry,sym.procdef[i],is_visible);
+        new(result);
+        result^.speedvalue:=sym.speedvalue;
+        result^.name:=stringdup(sym.name);
+        result^.next:=firstvmtentry;
+        result^.firstprocdef:=nil;
+        firstvmtentry:=result;
       end;
 
 
@@ -585,13 +578,6 @@ implementation
         if (tsym(sym).typ<>procsym) then
           exit;
 
-        { is this symbol visible from the class that we are
-          generating. This will be used to hide the other procdefs.
-          When the symbol is not visible we don't hide the other
-          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:=tprocsym(sym).is_visible_for_object(_class);
         { check the current list of symbols }
         _name:=sym.name;
         _speed:=sym.speedvalue;
@@ -609,6 +595,15 @@ implementation
               for i:=1 to Tprocsym(sym).procdef_count do
                 begin
                  pd:=Tprocsym(sym).procdef[i];
+
+                 { is this procdef visible from the class that we are
+                   generating. This will be used to hide the other procdefs.
+                   When the symbol is not visible we don't hide the other
+                   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);
+
                  if pd.procsym=sym then
                   begin
                     pdoverload:=(po_overload in pd.procoptions);
@@ -779,7 +774,20 @@ implementation
             end;
            vmtentry:=vmtentry^.next;
          end;
-        newvmtentry(tprocsym(sym),is_visible);
+
+        { Generate new procsym entry in vmt }
+        vmtentry:=newvmtentry(tprocsym(sym));
+
+        { Add procdefs }
+        for i:=1 to Tprocsym(sym).procdef_count do
+          begin
+            pd:=Tprocsym(sym).procdef[i];
+            { new entry is needed, override was not possible }
+            if (_class=pd._class) and
+               (po_overridingmethod in pd.procoptions) then
+              MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false));
+            newdefentry(vmtentry,pd,pd.is_visible_for_object(_class));
+          end;
       end;
 
 
@@ -1381,7 +1389,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.76  2004-09-21 17:25:12  peter
+  Revision 1.77  2004-10-12 14:34:49  peter
+    * fixed visibility for procsyms
+    * fixed override check when there was no entry yet
+
+  Revision 1.76  2004/09/21 17:25:12  peter
     * paraloc branch merged
 
   Revision 1.75  2004/09/13 20:31:07  peter

+ 30 - 1
compiler/symsym.pas

@@ -125,6 +125,7 @@ interface
           function search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
           function search_procdef_assignment_operator(fromdef,todef:tdef):Tprocdef;
           function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;override;
+          function is_visible_for_object(currobjdef:tdef):boolean;override;
 {$ifdef GDB}
           function stabstring : pchar;override;
 {$endif GDB}
@@ -525,6 +526,9 @@ implementation
 {$ifdef GDB}
          is_global:=false;
 {$endif GDB}
+         { the tprocdef have their own symoptions, make the procsym
+           always visible }
+         symoptions:=[sp_public];
          overloadchecked:=false;
          overloadcount:=0;
          procdef_count:=0;
@@ -1014,6 +1018,27 @@ implementation
       end;
 
 
+    function tprocsym.is_visible_for_object(currobjdef:tdef):boolean;
+      var
+        p : pprocdeflist;
+      begin
+        { This procsym is visible, when there is at least
+          one of the procdefs visible }
+        result:=false;
+        p:=pdlistfirst;
+        while assigned(p) do
+          begin
+             if p^.own and
+                p^.def.is_visible_for_object(tobjectdef(currobjdef)) then
+               begin
+                 result:=true;
+                 exit;
+               end;
+             p:=p^.next;
+          end;
+      end;
+
+
 {$ifdef GDB}
     function tprocsym.stabstring : pchar;
       begin
@@ -2229,7 +2254,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.185  2004-10-11 20:48:34  peter
+  Revision 1.186  2004-10-12 14:34:49  peter
+    * fixed visibility for procsyms
+    * fixed override check when there was no entry yet
+
+  Revision 1.185  2004/10/11 20:48:34  peter
     * don't generate stabs for self when it is in a regvar
 
   Revision 1.184  2004/10/11 15:48:15  peter

+ 6 - 2
compiler/symtype.pas

@@ -123,7 +123,7 @@ interface
          function  gettypedef:tdef;virtual;
          procedure load_references(ppufile:tcompilerppufile;locals:boolean);virtual;
          function  write_references(ppufile:tcompilerppufile;locals:boolean):boolean;virtual;
-         function is_visible_for_object(currobjdef:Tdef):boolean;
+         function is_visible_for_object(currobjdef:Tdef):boolean;virtual;
       end;
 
 {************************************************
@@ -1487,7 +1487,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.44  2004-07-09 22:17:32  peter
+  Revision 1.45  2004-10-12 14:34:49  peter
+    * fixed visibility for procsyms
+    * fixed override check when there was no entry yet
+
+  Revision 1.44  2004/07/09 22:17:32  peter
     * revert has_localst patch
     * replace aktstaticsymtable/aktglobalsymtable with current_module