Browse Source

* calling of private method allowed inside child object method

pierre 27 years ago
parent
commit
136cf23427
1 changed files with 28 additions and 5 deletions
  1. 28 5
      compiler/pexpr.pas

+ 28 - 5
compiler/pexpr.pas

@@ -613,6 +613,7 @@ unit pexpr;
       var
       var
          static_name : string;
          static_name : string;
          isclassref : boolean;
          isclassref : boolean;
+         pobj : pobjectdef;
 
 
       begin
       begin
          if sym=nil then
          if sym=nil then
@@ -630,9 +631,21 @@ unit pexpr;
            begin
            begin
               isclassref:=pd^.deftype=classrefdef;
               isclassref:=pd^.deftype=classrefdef;
               { check protected and private members }
               { check protected and private members }
+              { protected field can be changed inside
+                child object methods at least in BP (PM) }
               if ((sym^.properties and sp_private)<>0) and
               if ((sym^.properties and sp_private)<>0) and
                  (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
                  (pobjectdef(sym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
-                Message(parser_e_cant_access_private_member);
+                begin
+                  if assigned(aktprocsym^.definition^._class) then
+                    begin
+                       if not aktprocsym^.definition^._class^.isrelated(
+                          pobjectdef(sym^.owner^.defowner)) then
+                         Message(parser_e_cant_access_private_member);
+                    end
+                  else
+                    Message(parser_e_cant_access_private_member);
+                end;
+                
               { this is wrong protected should not be overwritten but
               { this is wrong protected should not be overwritten but
               can be called !! PM
               can be called !! PM
               if ((sym^.properties and sp_protected)<>0) and
               if ((sym^.properties and sp_protected)<>0) and
@@ -808,9 +821,16 @@ unit pexpr;
                      if (srsym^.typ in [propertysym,procsym,varsym]) and
                      if (srsym^.typ in [propertysym,procsym,varsym]) and
                         (srsymtable^.symtabletype=objectsymtable) then
                         (srsymtable^.symtabletype=objectsymtable) then
                       begin
                       begin
-                        if ((srsym^.properties and sp_private)<>0) and
-                           (pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
-                          Message(parser_e_cant_access_private_member);
+                         if ((srsym^.properties and sp_private)<>0) and
+                            (pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
+                             if assigned(aktprocsym^.definition^._class) then
+                               begin
+                                  if not aktprocsym^.definition^._class^.isrelated(
+                                     pobjectdef(srsym^.owner^.defowner)) then
+                                    Message(parser_e_cant_access_private_member);
+                               end
+                             else
+                               Message(parser_e_cant_access_private_member);
                       end;
                       end;
                      case srsym^.typ of
                      case srsym^.typ of
               absolutesym : begin
               absolutesym : begin
@@ -1863,7 +1883,10 @@ unit pexpr;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.67  1998-10-19 08:54:57  pierre
+  Revision 1.68  1998-10-20 11:15:44  pierre
+   * calling of private method allowed inside child object method
+
+  Revision 1.67  1998/10/19 08:54:57  pierre
     * wrong stabs info corrected once again !!
     * wrong stabs info corrected once again !!
     + variable vmt offset with vmt field only if required
     + variable vmt offset with vmt field only if required
       implemented now !!!
       implemented now !!!