re PR fortran/51378 ([OOP] Structure constructor wrongly rejects parent components if only child has PRIVATE comps)

2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51378
        * symbol.c (gfc_find_component): Fix access check of parent
        components.

2011-12-08  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51378
        * gfortran.dg/private_type_14.f90: New.

From-SVN: r182133

4 files changed, 69 insertions, 15 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 602059f..986ee2d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2011-12-08  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/51378
+	* symbol.c (gfc_find_component): Fix access check of parent
+	components.
+
+2011-12-08  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/51407
 	* io/transfer.c (require_numeric_type): New function.
 	(formatted_transfer_scalar_read, formatted_transfer_scalar_write):
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index de42297..fcc1ccf 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -2022,6 +2022,21 @@ gfc_find_component (gfc_symbol *sym, const char *name,
     if (strcmp (p->name, name) == 0)
       break;
 
+  if (p && sym->attr.use_assoc && !noaccess)
+    {
+      bool is_parent_comp = sym->attr.extension && (p == sym->components);
+      if (p->attr.access == ACCESS_PRIVATE ||
+	  (p->attr.access != ACCESS_PUBLIC
+	   && sym->component_access == ACCESS_PRIVATE
+	   && !is_parent_comp))
+	{
+	  if (!silent)
+	    gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
+		       name, sym->name);
+	  return NULL;
+	}
+    }
+
   if (p == NULL
 	&& sym->attr.extension
 	&& sym->components->ts.type == BT_DERIVED)
@@ -2037,21 +2052,6 @@ gfc_find_component (gfc_symbol *sym, const char *name,
     gfc_error ("'%s' at %C is not a member of the '%s' structure",
 	       name, sym->name);
 
-  else if (sym->attr.use_assoc && !noaccess)
-    {
-      bool is_parent_comp = sym->attr.extension && (p == sym->components);
-      if (p->attr.access == ACCESS_PRIVATE ||
-	  (p->attr.access != ACCESS_PUBLIC
-	   && sym->component_access == ACCESS_PRIVATE
-	   && !is_parent_comp))
-	{
-	  if (!silent)
-	    gfc_error ("Component '%s' at %C is a PRIVATE component of '%s'",
-		       name, sym->name);
-	  return NULL;
-	}
-    }
-
   return p;
 }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9eef856..452fddd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2011-12-08  Tobias Burnus  <burnus@net-b.de>
 
+	PR fortran/51378
+	* gfortran.dg/private_type_14.f90: New.
+
+2011-12-08  Tobias Burnus  <burnus@net-b.de>
+
 	PR fortran/51407
 	* gfortran.dg/io_real_boz_3.f90: New.
 	* gfortran.dg/io_real_boz_4.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/private_type_14.f90 b/gcc/testsuite/gfortran.dg/private_type_14.f90
new file mode 100644
index 0000000..6c90b86
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/private_type_14.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+!
+! PR fortran/51378
+!
+! Allow constructor to nonprivate parent compoents,
+! even if the extension specified PRIVATE for its own components
+!
+! Contributed by Reinhold Bader
+!
+module type_ext
+  type :: vec
+     real, dimension(3) :: comp
+     integer :: len
+  end type vec
+  type, extends(vec) :: l_vec
+     private
+     character(len=20) :: label = '01234567890123456789'
+  end type l_vec
+end module type_ext
+program test_ext
+  use type_ext
+  implicit none
+  type(vec) :: o_vec, oo_vec
+  type(l_vec) :: o_l_vec
+  integer :: i
+!
+  o_vec = vec((/1.0, 2.0, 3.0/),3)
+!  write(*,*) o_vec%comp, o_vec%len
+  o_l_vec = l_vec(comp=(/1.0, 2.0, 3.0/),len=3)
+! partial constr. not accepted by ifort 11.1, fixed in 12.0 (issue 562240)
+!  write(*,*) o_l_vec%comp, o_l_vec%len
+!  write(*,*) o_l_vec%vec
+  oo_vec = o_l_vec%vec
+  do i=1, 3
+    if (abs(oo_vec%comp(i) - o_vec%comp(i)) > 1.0E-5) then
+       write(*, *) 'FAIL'
+       stop
+    end if
+  end do
+  write(*, *) 'OK'
+end program
+
+! { dg-final { cleanup-modules "type_ext" } }