+ explanation for the parameters of is_visible_for_object

  * fixed accessibility checking for strict_protected (the class
    in which the access occurs also has to be related to the
    objectdef of which a symbol is accessed) + test


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@22565 3ad0048d-3df7-0310-abae-a5850022a9f2

4 files changed, 81 insertions, 2 deletions

diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index f50a12143e..845044a3e6 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -2113,6 +2113,12 @@ implementation
         result:=false;
       end;
 
+    { symst: symboltable that contains the symbol (-> symowner def: record/objectdef in which the symbol is defined)
+      symvisibility: visibility of the symbol
+      contextobjdef: via which def the symbol is accessed, e.g.:
+        fieldname:=1 -> contextobjdef = current_structdef
+        objfield.fieldname:=1 -> contextobjdef = def of objfield
+    }
     function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean;
       var
         symownerdef : tabstractrecorddef;
@@ -2156,9 +2162,16 @@ implementation
           vis_strictprotected :
             begin
                result:=(
+                         { access from nested class }
                          assigned(current_structdef) and
-                         (current_structdef.is_related(symownerdef) or
-                         is_owned_by(current_structdef,symownerdef))
+                         is_owned_by(current_structdef,symownerdef)
+                       ) or
+                       (
+                         { access from child class }
+                         assigned(contextobjdef) and
+                         assigned(current_structdef) and
+                         contextobjdef.is_related(symownerdef) and
+                         current_structdef.is_related(contextobjdef)
                        ) or
                        (
                          { helpers can access strict protected symbols }
diff --git a/tests/test/tsprot.pp b/tests/test/tsprot.pp
new file mode 100644
index 0000000000..871dba6c55
--- /dev/null
+++ b/tests/test/tsprot.pp
@@ -0,0 +1,27 @@
+{ %fail }
+
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+unit tsprot;
+
+interface
+
+uses
+  usprot1,usprot2;
+
+type
+  tchild2 = class(tbase)
+    f: tchild1;
+    procedure test;
+  end;
+
+implementation
+
+procedure tchild2.test;
+  begin
+    f.pmethod;
+  end;
+
+end.
diff --git a/tests/test/usprot1.pp b/tests/test/usprot1.pp
new file mode 100644
index 0000000000..954dac84aa
--- /dev/null
+++ b/tests/test/usprot1.pp
@@ -0,0 +1,21 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+unit usprot1;
+
+interface
+
+type
+  tbase = class
+   strict protected
+    procedure pmethod; virtual; overload;
+  end;
+
+implementation
+
+procedure tbase.pmethod;
+begin
+end;
+
+end.
diff --git a/tests/test/usprot2.pp b/tests/test/usprot2.pp
new file mode 100644
index 0000000000..0f0eaf8043
--- /dev/null
+++ b/tests/test/usprot2.pp
@@ -0,0 +1,18 @@
+{$ifdef fpc}
+{$mode delphi}
+{$endif}
+
+unit usprot2;
+
+interface
+
+uses
+  usprot1;
+
+type
+  tchild1 = class(tbase)
+  end;
+
+implementation
+
+end.