compiler: fix visibility of inherited protected members (mantis #0018087) and strict private/protected members (mantis #0018085) to nested classes

git-svn-id: trunk@16473 -

.gitattributes

@@ -10767,6 +10767,7 @@ tests/webtbs/tw17986.pp svneol=native#text/pascal
 tests/webtbs/tw17998.pp svneol=native#text/plain
 tests/webtbs/tw18013.pp svneol=native#text/plain
 tests/webtbs/tw18075.pp svneol=native#text/pascal
+tests/webtbs/tw18085.pp svneol=native#text/pascal
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw1825.pp svneol=native#text/plain
 tests/webtbs/tw1850.pp svneol=native#text/plain
@@ -11616,6 +11617,8 @@ tests/webtbs/uw17220.pp svneol=native#text/plain
 tests/webtbs/uw17220a.pp svneol=native#text/plain
 tests/webtbs/uw17493.pp svneol=native#text/plain
 tests/webtbs/uw17950.pas svneol=native#text/pascal
+tests/webtbs/uw18087a.pp svneol=native#text/pascal
+tests/webtbs/uw18087b.pp svneol=native#text/pascal
 tests/webtbs/uw2004.inc svneol=native#text/plain
 tests/webtbs/uw2040.pp svneol=native#text/plain
 tests/webtbs/uw2266a.inc svneol=native#text/plain

compiler/symtable.pas

@@ -97,6 +97,7 @@ interface
           databitsize    : aint;
           procedure setdatasize(val: aint);
         public
+          function iscurrentunit: boolean; override;
           property datasize : aint read _datasize write setdatasize;
        end;
 
@@ -1028,6 +1029,11 @@ implementation
           databitsize:=val*8;
       end;
 
+    function tabstractrecordsymtable.iscurrentunit: boolean;
+      begin
+        Result := Assigned(current_module) and (current_module.moduleid=moduleid);
+      end;
+
 {****************************************************************************
                               TRecordSymtable
 ****************************************************************************}
@@ -1667,6 +1673,14 @@ implementation
 
 
     function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tobjectdef):boolean;
+
+      function is_holded_by(childdef,ownerdef: tobjectdef): boolean;
+        begin
+          result:=childdef=ownerdef;
+          if not result and (childdef.owner.symtabletype=ObjectSymtable) then
+            result:=is_holded_by(tobjectdef(childdef.owner.defowner),ownerdef);
+        end;
+
       var
         symownerdef : tobjectdef;
       begin
@@ -1692,24 +1706,25 @@ implementation
                          assigned(current_objectdef) and
                          (
                            (current_objectdef=symownerdef) or
-                           (current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
+                           (current_objectdef.owner.iscurrentunit)
                          )
                        ) or
                        (
                          not assigned(current_objectdef) and
-                         (symownerdef.owner.moduleid=current_module.moduleid)
+                         (symownerdef.owner.iscurrentunit)
                        )
                       );
             end;
           vis_strictprivate :
             begin
               result:=assigned(current_objectdef) and
-                      (current_objectdef=symownerdef);
+                      is_holded_by(current_objectdef,symownerdef);
             end;
           vis_strictprotected :
             begin
                result:=assigned(current_objectdef) and
-                       current_objectdef.is_related(symownerdef);
+                       (current_objectdef.is_related(symownerdef) or
+                        is_holded_by(current_objectdef,symownerdef));
             end;
           vis_protected :
             begin
@@ -1723,7 +1738,7 @@ implementation
                        ) or
                        (
                         assigned(contextobjdef) and
-                        (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable]) and
+                        (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable]) and
                         (contextobjdef.owner.iscurrentunit) and
                         contextobjdef.is_related(symownerdef)
                        ) or
@@ -1733,12 +1748,12 @@ implementation
                           assigned(current_objectdef) and
                           (
                             (current_objectdef=symownerdef) or
-                            (current_objectdef.owner.moduleid=symownerdef.owner.moduleid)
+                            (current_objectdef.owner.iscurrentunit)
                           )
                         ) or
                         (
                           not assigned(current_objectdef) and
-                          (symownerdef.owner.moduleid=current_module.moduleid)
+                          (symownerdef.owner.iscurrentunit)
                          )
                        )
                       );

tests/webtbs/tw18085.pp

@@ -0,0 +1,21 @@
+program Project1;
+
+{$mode delphi}
+
+uses
+  uw18087a, uw18087b;
+
+type
+  TFoo1 = class
+  strict private
+    type
+      TFoo2 = record
+      end;
+      TFoo3 = class
+        FFoo2: TFoo2; // was error: Identifier not found "TFoo2"
+      end;
+  end;
+
+begin
+end.
+

tests/webtbs/uw18087a.pp

@@ -0,0 +1,19 @@
+unit uw18087a;
+
+interface
+
+{$mode delphi}
+
+type
+  TFoo1 = class
+  protected // it worked if "protected" was removed
+    procedure Proc1; virtual;
+  end;
+
+implementation
+
+  procedure TFoo1.Proc1;
+  begin
+  end;
+
+end.

tests/webtbs/uw18087b.pp

@@ -0,0 +1,25 @@
+unit uw18087b; 
+
+interface
+
+{$mode delphi}
+
+uses
+  uw18087a;
+
+type
+  TFoo2 = class
+  type
+    TFoo3 = class(TFoo1)
+    protected
+      procedure Proc1; override; // was error: There is no method in an ancestor class to be overridden: "TFoo2.TFoo3.Proc1;"
+    end;
+  end;
+
+implementation
+
+procedure TFoo2.TFoo3.Proc1;
+begin
+end;
+
+end.