* protected/private symbols parsing fixed

compiler/htypechk.pas

@@ -94,8 +94,6 @@ interface
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);
 
     { subroutine handling }
-    procedure test_protected_sym(sym : tsym);
-    procedure test_protected(p : tnode);
     function  is_procsym_load(p:tnode):boolean;
     function  is_procsym_call(p:tnode):boolean;
     procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef);
@@ -465,51 +463,11 @@ implementation
           CGMessage(cg_e_too_complex_expr); now pushed if needed PM }
       end;
 
+
 {****************************************************************************
                           Subroutine Handling
 ****************************************************************************}
 
-{ protected field handling
-  protected field can not appear in
-  var parameters of function !!
-  this can only be done after we have determined the
-  overloaded function
-  this is the reason why it is not in the parser, PM }
-
-    procedure test_protected_sym(sym : tsym);
-      begin
-         if (sp_protected in sym.symoptions) and
-            (
-             (
-              (sym.owner.symtabletype=globalsymtable) and
-              (sym.owner.unitid<>0)
-             ) or
-             (
-              (sym.owner.symtabletype=objectsymtable) and
-              (tobjectdef(sym.owner.defowner).owner.symtabletype=globalsymtable) and
-              (tobjectdef(sym.owner.defowner).owner.unitid<>0)
-             )
-            ) then
-          CGMessage(parser_e_cant_access_protected_member);
-      end;
-
-
-    procedure test_protected(p : tnode);
-      begin
-        case p.nodetype of
-         loadn : test_protected_sym(tloadnode(p).symtableentry);
-     typeconvn : test_protected(ttypeconvnode(p).left);
-        derefn : test_protected(tderefnode(p).left);
-    subscriptn : begin
-                 { test_protected(p.left);
-                   Is a field of a protected var
-                   also protected ???  PM }
-                   test_protected_sym(tsubscriptnode(p).vs);
-                 end;
-        end;
-      end;
-
-
     function is_procsym_load(p:tnode):boolean;
       begin
          is_procsym_load:=((p.nodetype=loadn) and (tloadnode(p).symtableentry.typ=procsym)) or
@@ -979,7 +937,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.39  2001-11-08 21:55:36  marco
+  Revision 1.40  2001-12-31 16:59:41  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.39  2001/11/08 21:55:36  marco
    * Fix from Peter. Fixes a hang when ptop's upperstr procedure is converted
      to ansistrings
 

compiler/i386/cpuasm.pas

@@ -102,6 +102,7 @@ type
 {$ifndef NOAG386BIN}
   public
      { the next will reset all instructions that can change in pass 2 }
+     procedure ResetPass1;
      procedure ResetPass2;
      function  CheckIfValid:boolean;
      function  Pass1(offset:longint):longint;virtual;
@@ -769,6 +770,17 @@ begin
 end;
 
 
+procedure taicpu.ResetPass1;
+begin
+  { we need to reset everything here, because the choosen insentry
+    can be invalid for a new situation where the previously optimized
+    insentry is not correct }
+  InsEntry:=nil;
+  InsSize:=0;
+  LastInsOffset:=-1;
+end;
+
+
 procedure taicpu.ResetPass2;
 begin
   { we are here in a second pass, check if the instruction can be optimized }
@@ -1304,6 +1316,12 @@ var
   data,s,opidx : longint;
   ea_data : ea;
 begin
+{$ifdef EXTDEBUG}
+  { safety check }
+  if objectdata.currsectionsize<>insoffset then
+   internalerror(200130121);
+{$endif EXTDEBUG}
+  { load data to write }
   codes:=insentry^.code;
   { Force word push/pop for registers }
   if (opsize=S_W) and ((codes[0]=#4) or (codes[0]=#6) or
@@ -1575,7 +1593,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.16  2001-12-29 15:29:59  jonas
+  Revision 1.17  2001-12-31 16:59:43  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.16  2001/12/29 15:29:59  jonas
     * powerpc/cgcpu.pas compiles :)
     * several powerpc-related fixes
     * cpuasm unit is now based on common tainst unit

compiler/ncal.pas

@@ -176,7 +176,7 @@ implementation
             begin
               if (srsym.typ<>procsym) then
                internalerror(200111022);
-              if srsym.check_private then
+              if srsym.is_visible_for_proc(aktprocdef) then
                begin
                  srpdl:=srsym.defs;
                  while assigned(srpdl) do
@@ -540,10 +540,8 @@ implementation
     procedure tcallparanode.gen_high_tree(openstring:boolean);
       var
         temp: tnode;
-        len : longint;
-        st  : tsymtable;
+        len : integer;
         loadconst : boolean;
-        srsym : tsym;
       begin
         if assigned(hightree) then
           exit;
@@ -1755,7 +1753,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2001-12-11 13:21:36  jonas
+  Revision 1.61  2001-12-31 16:59:41  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.60  2001/12/11 13:21:36  jonas
     * fixed to my previous patch: the hightree must always be converted to a
       longint
 

compiler/nobj.pas

@@ -561,7 +561,7 @@ implementation
          if tsym(sym).typ=procsym then
            begin
               { skip private symbols that can not been seen }
-              if not tsym(sym).check_private then
+              if not tstoredsym(sym).is_visible_for_object(_class) then
                exit;
 
               { check the current list of symbols }
@@ -1275,7 +1275,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.11  2001-11-20 18:49:43  peter
+  Revision 1.12  2001-12-31 16:59:41  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.11  2001/11/20 18:49:43  peter
     * require overload for cross object overloading
 
   Revision 1.10  2001/11/18 20:18:54  peter

compiler/pdecobj.pas

@@ -46,7 +46,6 @@ implementation
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
       var
-         actmembertype : tsymoptions;
          there_is_a_destructor : boolean;
          classtype : tobjectdeftype;
          childof : tobjectdef;
@@ -586,6 +585,7 @@ implementation
          hs      : string;
          pcrd       : tclassrefdef;
          tt     : ttype;
+         old_object_option : tsymoptions;
          oldprocinfo : pprocinfo;
          oldprocsym : tprocsym;
          oldprocdef : tprocdef;
@@ -605,8 +605,6 @@ implementation
                   begin
                      include(aktclass.objectoptions,oo_can_have_published);
                      { in "publishable" classes the default access type is published }
-                     actmembertype:=[sp_published];
-                     { don't know if this is necessary (FK) }
                      current_object_option:=[sp_published];
                   end;
              end;
@@ -894,13 +892,12 @@ implementation
           it.}
          oldprocdef:=aktprocdef;
          oldprocsym:=aktprocsym;
+         old_object_option:=current_object_option;
+
          { forward is resolved }
          if assigned(fd) then
            exclude(fd.objectoptions,oo_is_forward);
 
-         there_is_a_destructor:=false;
-         actmembertype:=[sp_public];
-
          { objects and class types can't be declared local }
          if not(symtablestack.symtabletype in [globalsymtable,staticsymtable]) then
            Message(parser_e_no_local_objects);
@@ -918,12 +915,14 @@ implementation
          if n='' then
            Message(parser_f_no_anonym_objects);
 
+         { read list of parent classes }
          readparentclasses;
 
          { default access is public }
-         actmembertype:=[sp_public];
+         there_is_a_destructor:=false;
+         current_object_option:=[sp_public];
 
-         { set class flags and inherits published, if necessary? }
+         { set class flags and inherits published }
          setclassattributes;
 
          aktobjectdef:=aktclass;
@@ -937,16 +936,11 @@ implementation
          new(procinfo,init);
          procinfo^._class:=aktclass;
 
-
          { short class declaration ? }
          if (classtype<>odt_class) or (token<>_SEMICOLON) then
           begin
           { Parse componenten }
             repeat
-              if (sp_private in actmembertype) then
-                include(aktclass.objectoptions,oo_has_private);
-              if (sp_protected in actmembertype) then
-                include(aktclass.objectoptions,oo_has_protected);
               case token of
                 _ID :
                   begin
@@ -956,8 +950,8 @@ implementation
                           if is_interface(aktclass) then
                              Message(parser_e_no_access_specifier_in_interfaces);
                            consume(_PRIVATE);
-                           actmembertype:=[sp_private];
                            current_object_option:=[sp_private];
+                           include(aktclass.objectoptions,oo_has_private);
                          end;
                        _PROTECTED :
                          begin
@@ -965,7 +959,7 @@ implementation
                              Message(parser_e_no_access_specifier_in_interfaces);
                            consume(_PROTECTED);
                            current_object_option:=[sp_protected];
-                           actmembertype:=[sp_protected];
+                           include(aktclass.objectoptions,oo_has_protected);
                          end;
                        _PUBLIC :
                          begin
@@ -973,7 +967,6 @@ implementation
                              Message(parser_e_no_access_specifier_in_interfaces);
                            consume(_PUBLIC);
                            current_object_option:=[sp_public];
-                           actmembertype:=[sp_public];
                          end;
                        _PUBLISHED :
                          begin
@@ -984,7 +977,6 @@ implementation
                                Message(parser_e_cant_have_published);
                            consume(_PUBLISHED);
                            current_object_option:=[sp_published];
-                           actmembertype:=[sp_published];
                          end;
                        else
                          begin
@@ -1030,7 +1022,7 @@ implementation
                   end;
                 _CONSTRUCTOR :
                   begin
-                    if not(sp_public in actmembertype) then
+                    if not(sp_public in current_object_option) then
                       Message(parser_w_constructor_should_be_public);
                     if is_interface(aktclass) then
                       Message(parser_e_no_con_des_in_interfaces);
@@ -1057,7 +1049,7 @@ implementation
                     if is_interface(aktclass) then
                       Message(parser_e_no_con_des_in_interfaces);
                     there_is_a_destructor:=true;
-                    if not(sp_public in actmembertype) then
+                    if not(sp_public in current_object_option) then
                       Message(parser_w_destructor_should_be_public);
                     oldparse_only:=parse_only;
                     parse_only:=true;
@@ -1084,7 +1076,6 @@ implementation
                   consume(_ID); { Give a ident expected message, like tp7 }
               end;
             until false;
-            current_object_option:=[sp_public];
           end;
 
          { generate vmt space if needed }
@@ -1110,6 +1101,7 @@ implementation
          {Restore the aktprocsym.}
          aktprocsym:=oldprocsym;
          aktprocdef:=oldprocdef;
+         current_object_option:=old_object_option;
 
          object_dec:=aktclass;
       end;
@@ -1117,7 +1109,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.34  2001-12-06 17:57:35  florian
+  Revision 1.35  2001-12-31 16:59:41  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.34  2001/12/06 17:57:35  florian
     + parasym to tparaitem added
 
   Revision 1.33  2001/11/02 22:58:02  peter

compiler/pdecsub.pas

@@ -115,6 +115,7 @@ implementation
         inserthigh : boolean;
         tdefaultvalue : tconstsym;
         defaultrequired : boolean;
+        old_object_option : tsymoptions;
       begin
         { reset }
         defaultrequired:=false;
@@ -128,6 +129,9 @@ implementation
         if try_to_consume(_RKLAMMER) and
           not(m_tp7 in aktmodeswitches) then
           exit;
+        { the variables are always public }
+        old_object_option:=current_object_option;
+        current_object_option:=[sp_public];
         inc(testcurobject);
         repeat
           if try_to_consume(_VAR) then
@@ -331,6 +335,7 @@ implementation
         if not is_procvar then
           tprocdef(aktprocdef).setmangledname(hs2);
         dec(testcurobject);
+        current_object_option:=old_object_option;
         consume(_RKLAMMER);
       end;
 
@@ -2009,7 +2014,10 @@ const
 end.
 {
   $Log$
-  Revision 1.42  2001-12-06 17:57:36  florian
+  Revision 1.43  2001-12-31 16:59:42  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.42  2001/12/06 17:57:36  florian
     + parasym to tparaitem added
 
   Revision 1.41  2001/11/02 22:58:03  peter

compiler/pexpr.pas

@@ -1080,7 +1080,6 @@ implementation
          static_name : string;
          isclassref : boolean;
          srsymtable : tsymtable;
-         objdef : tobjectdef;
 
       begin
          if sym=nil then
@@ -1104,29 +1103,6 @@ implementation
               else
                isclassref:=false;
 
-              objdef:=tobjectdef(sym.owner.defowner);
-
-              { check protected and private members        }
-              { please leave this code as it is,           }
-              { it has now the same behaviaor as TP/Delphi }
-              if (sp_private in sym.symoptions) and
-                 (objdef.owner.symtabletype=globalsymtable) and
-                 (objdef.owner.unitid<>0) then
-               Message(parser_e_cant_access_private_member);
-
-              if (sp_protected in sym.symoptions) and
-                 (objdef.owner.symtabletype=globalsymtable) and
-                 (objdef.owner.unitid<>0) then
-                begin
-                  if assigned(aktprocdef._class) then
-                    begin
-                       if not aktprocdef._class.is_related(objdef) then
-                         Message(parser_e_cant_access_protected_member);
-                    end
-                  else
-                    Message(parser_e_cant_access_protected_member);
-                end;
-
               { we assume, that only procsyms and varsyms are in an object }
               { symbol table, for classes, properties are allowed          }
               case sym.typ of
@@ -2508,7 +2484,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.52  2001-12-06 17:57:36  florian
+  Revision 1.53  2001-12-31 16:59:42  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.52  2001/12/06 17:57:36  florian
     + parasym to tparaitem added
 
   Revision 1.51  2001/11/14 01:12:44  florian

compiler/ptype.pas

@@ -203,7 +203,7 @@ implementation
       var
          symtable : tsymtable;
          storetypecanbeforward : boolean;
-
+         old_object_option : tsymoptions;
       begin
          { create recdef }
          symtable:=trecordsymtable.create;
@@ -213,6 +213,8 @@ implementation
          symtablestack:=symtable;
          { parse record }
          consume(_RECORD);
+         old_object_option:=current_object_option;
+         current_object_option:=[sp_public];
          storetypecanbeforward:=typecanbeforward;
          { for tp mode don't allow forward types }
          if m_tp in aktmodeswitches then
@@ -220,6 +222,7 @@ implementation
          read_var_decs(true,false,false);
          consume(_END);
          typecanbeforward:=storetypecanbeforward;
+         current_object_option:=old_object_option;
          { may be scale record size to a size of n*4 ? }
          symtablestack.datasize:=align(symtablestack.datasize,symtablestack.dataalignment);
          { restore symtable stack }
@@ -604,7 +607,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.30  2001-08-30 20:13:53  peter
+  Revision 1.31  2001-12-31 16:59:43  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.30  2001/08/30 20:13:53  peter
     * rtti/init table updates
     * rttisym for reusable global rtti/init info
     * support published for interfaces

compiler/symsym.pas

@@ -66,6 +66,8 @@ 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;
        end;
 
        tlabelsym = class(tstoredsym)
@@ -538,6 +540,67 @@ 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
+           (owner.defowner.owner.symtabletype=globalsymtable) 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=globalsymtable) 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;
+
+        { private symbols are allowed when we are in the same
+          module as they are defined }
+        if (sp_private in symoptions) and
+           (owner.defowner.owner.symtabletype=globalsymtable) 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=globalsymtable) and
+             (owner.defowner.owner.unitid<>0)
+            ) and
+            not(
+                assigned(currobjdef) and
+                currobjdef.is_related(tobjectdef(owner.defowner))
+               )
+           ) then
+          exit;
+
+        is_visible_for_object:=true;
+      end;
+
+
 {****************************************************************************
                                  TLABELSYM
 ****************************************************************************}
@@ -703,7 +766,16 @@ implementation
 
 
     destructor tprocsym.destroy;
+      var
+         hp,p : pprocdeflist;
       begin
+         p:=defs;
+         while assigned(p) do
+           begin
+              hp:=p^.next;
+              dispose(p);
+              p:=hp;
+           end;
          inherited destroy;
       end;
 
@@ -844,6 +916,7 @@ implementation
     function tprocsym.stabstring : pchar;
       begin
         internalerror(200111171);
+        stabstring:=nil;
       end;
 
     procedure tprocsym.concatstabto(asmlist : taasmoutput);
@@ -2440,7 +2513,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.29  2001-12-03 21:48:42  peter
+  Revision 1.30  2001-12-31 16:59:43  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.29  2001/12/03 21:48:42  peter
     * freemem change to value parameter
     * torddef low/high range changed to int64
 

compiler/symtable.pas

@@ -182,7 +182,6 @@ interface
           constructor create(aowner:tdef;asymsearch:TDictionary);
           destructor  destroy;override;
           procedure clear;override;
-          function  speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;override;
         end;
 
        tstt_exceptsymtable = class(tsymtable)
@@ -213,7 +212,7 @@ interface
 {*** Search ***}
     function  searchsym(const s : stringid;var srsym:tsym;var srsymtable:tsymtable):boolean;
     function  searchsymonlyin(p : tsymtable;const s : stringid):tsym;
-    function searchsystype(const s: stringid; var srsym: ttypesym): boolean;
+    function  searchsystype(const s: stringid; var srsym: ttypesym): boolean;
     function  searchsysvar(const s: stringid; var srsym: tvarsym; var symowner: tsymtable): boolean;
     function  search_class_member(pd : tobjectdef;const s : string):tsym;
 
@@ -831,10 +830,8 @@ implementation
 
     procedure tstoredsymtable.chainoperators;
       var
-        p : tprocsym;
         pd : pprocdeflist;
         t : ttoken;
-        def : tprocdef;
         srsym : tsym;
         srsymtable,
         storesymtablestack : tsymtable;
@@ -844,8 +841,6 @@ implementation
          make_ref:=false;
          for t:=first_overloaded to last_overloaded do
            begin
-              p:=nil;
-              def:=nil;
               overloaded_operators[t]:=nil;
               { each operator has a unique lowercased internal name PM }
               while assigned(symtablestack) do
@@ -1103,7 +1098,7 @@ implementation
               { but private ids can be reused }
               hsym:=search_class_member(tobjectdef(defowner),sym.name);
               if assigned(hsym) and
-                 hsym.check_private then
+                 tstoredsym(hsym).is_visible_for_object(tobjectdef(defowner)) then
                begin
                  DuplicateSym(hsym);
                  exit;
@@ -1270,7 +1265,7 @@ implementation
               hsym:=search_class_member(procinfo^._class,sym.name);
               { private ids can be reused }
               if assigned(hsym) and
-                 hsym.check_private then
+                 tstoredsym(hsym).is_visible_for_object(procinfo^._class) then
                begin
                  { delphi allows to reuse the names in a class, but not
                    in object (tp7 compatible) }
@@ -1643,24 +1638,6 @@ implementation
       end;
 
 
-    function twithsymtable.speedsearch(const s : stringid;speedvalue : cardinal) : tsymentry;
-      var
-        hp : tsym;
-      begin
-        hp:=tsym(inherited speedsearch(s, speedvalue));
-
-        { skip private members that can't be seen }
-        if assigned(hp) and
-           (sp_private in hp.symoptions) and
-           (hp.owner.symtabletype=objectsymtable) and
-           (hp.owner.defowner.owner.symtabletype=globalsymtable) and
-           (hp.owner.defowner.owner.unitid<>0) then
-          hp:=nil;
-
-        speedsearch:=hp;
-      end;
-
-
 {****************************************************************************
                           TSTT_ExceptionSymtable
 ****************************************************************************}
@@ -1731,7 +1708,8 @@ implementation
          while assigned(srsymtable) do
            begin
               srsym:=tsym(srsymtable.speedsearch(s,speedvalue));
-              if assigned(srsym) then
+              if assigned(srsym) and
+                 tstoredsym(srsym).is_visible_for_proc(aktprocdef) then
                begin
                  searchsym:=true;
                  exit;
@@ -2045,7 +2023,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.50  2001-11-18 18:43:17  peter
+  Revision 1.51  2001-12-31 16:59:43  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.50  2001/11/18 18:43:17  peter
     * overloading supported in child classes
     * fixed parsing of classes with private and virtual and overloaded
       so it is compatible with delphi

compiler/symtype.pas

@@ -91,7 +91,6 @@ interface
          function  realname:string;
          procedure deref;virtual;abstract;
          function  gettypedef:tdef;virtual;
-         function  check_private:boolean;
       end;
 
 {************************************************
@@ -222,15 +221,6 @@ implementation
       end;
 
 
-    function tsym.check_private:boolean;
-      begin
-        { private symbols are allowed when we are in the same
-          module as they are defined }
-        check_private:=not(sp_private in symoptions) or
-                       (owner.defowner.owner.unitid=0);
-      end;
-
-
 {****************************************************************************
                                TRef
 ****************************************************************************}
@@ -527,7 +517,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.12  2001-11-18 18:43:18  peter
+  Revision 1.13  2001-12-31 16:59:43  peter
+    * protected/private symbols parsing fixed
+
+  Revision 1.12  2001/11/18 18:43:18  peter
     * overloading supported in child classes
     * fixed parsing of classes with private and virtual and overloaded
       so it is compatible with delphi