re PR fortran/42545 (type extension: parent component has wrong accessibility)

gcc/fortran/
2010-01-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42545
	* resolve.c (resolve_fl_derived): Set the accessibility of the parent
	component for extended types.
	* symbol.c (gfc_find_component): Remove a wrongly-worded error message
	and take care of parent component accessibility.

gcc/testsuite/
2010-01-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42545
	* gfortran.dg/extends_6.f03: Modified an error message.
	* gfortran.dg/extends_10.f03: New test.
	* gfortran.dg/private_type_6.f03: Modified an error message.
	* gfortran.dg/structure_constructor_8.f03: Ditto.

From-SVN: r156040

gcc/fortran/ChangeLog

@@ -1,3 +1,11 @@
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42545
+	* resolve.c (resolve_fl_derived): Set the accessibility of the parent
+	component for extended types.
+	* symbol.c (gfc_find_component): Remove a wrongly-worded error message
+	and take care of parent component accessibility.
+
 2010-01-17  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/42677

gcc/fortran/resolve.c

@@ -10494,6 +10494,12 @@ resolve_fl_derived (gfc_symbol *sym)
 	  && resolve_typespec_used (&c->ts, &c->loc, c->name) == FAILURE)
 	return FAILURE;
 
+      /* If this type is an extension, set the accessibility of the parent
+	 component.  */
+      if (super_type && c == sym->components
+	  && strcmp (super_type->name, c->name) == 0)
+	c->attr.access = super_type->attr.access;
+      
       /* If this type is an extension, see if this component has the same name
 	 as an inherited type-bound procedure.  */
       if (super_type

gcc/fortran/symbol.c

@@ -1958,23 +1958,17 @@ gfc_find_component (gfc_symbol *sym, const char *name,
 
   else if (sym->attr.use_assoc && !noaccess)
     {
-      if (p->attr.access == ACCESS_PRIVATE)
+      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 there were components given and all components are private, error
-	 out at this place.  */
-      if (p->attr.access != ACCESS_PUBLIC && sym->component_access == ACCESS_PRIVATE)
-	{
-	  if (!silent)
-	    gfc_error ("All components of '%s' are PRIVATE in structure"
-		       " constructor at %C", sym->name);
-	  return NULL;
-	}
     }
 
   return p;

gcc/testsuite/ChangeLog

@@ -1,3 +1,11 @@
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42545
+	* gfortran.dg/extends_6.f03: Modified an error message.
+	* gfortran.dg/extends_10.f03: New test.
+	* gfortran.dg/private_type_6.f03: Modified an error message.
+	* gfortran.dg/structure_constructor_8.f03: Ditto.
+
 2010-01-19  Jakub Jelinek  <jakub@redhat.com>
 
 	PR tree-optimization/42719

gcc/testsuite/gfortran.dg/extends_10.f03

@@ -0,0 +1,34 @@
+! { dg-do compile }
+!
+! PR 42545: type extension: parent component has wrong accessibility
+!
+! Reported by Reinhold Bader <bader@lrz.de>
+
+module mo
+  implicit none
+  type :: t1
+    integer :: i = 1
+  end type
+  type, extends(t1) :: t2
+    private
+    real :: x = 2.0
+  end type
+  type :: u1
+    integer :: j = 1
+  end type
+  type, extends(u1) :: u2
+    real :: y = 2.0
+  end type
+  private :: u1
+end module
+
+program pr
+  use mo
+  implicit none
+  type(t2) :: a
+  type(u2) :: b
+  print *,a%t1%i
+  print *,b%u1%j  ! { dg-error "is a PRIVATE component of" }
+end program
+
+! { dg-final { cleanup-modules "mo" } }

gcc/testsuite/gfortran.dg/extends_6.f03

@@ -30,7 +30,7 @@ end module m
   end type two
 
   o_dt%day = 5  ! VALID but failed in first version of EXTENDS patch
-  o_dt%yr  = 5  ! { dg-error "All components of 'date' are PRIVATE" }
+  o_dt%yr  = 5  ! { dg-error "is a PRIVATE component of" }
 
   t = two(one = one(4), i = 5, r=4.4) ! { dg-error "has already been set" }
 

gcc/testsuite/gfortran.dg/private_type_6.f90

@@ -18,7 +18,7 @@ program foo_test
   implicit none
   TYPE(footype) :: foo
   TYPE(bartype) :: foo2
-  foo  = footype(1) ! { dg-error "All components of 'footype' are PRIVATE" }
+  foo  = footype(1) ! { dg-error "is a PRIVATE component" }
   foo2 = bartype(1,2) ! { dg-error "is a PRIVATE component" }
   foo2%dummy2 = 5 ! { dg-error "is a PRIVATE component" }
 end program foo_test

gcc/testsuite/gfortran.dg/structure_constructor_8.f03

@@ -51,7 +51,7 @@ PROGRAM test
   struct1 = haspriv_t (b = 2, a = 1) ! { dg-error "is a PRIVATE component" }
 
   ! This should fail as all components are private
-  struct2 = allpriv_t (5) ! { dg-error "of 'allpriv_t' are PRIVATE" }
+  struct2 = allpriv_t (5) ! { dg-error "is a PRIVATE component" }
 
   ! This should fail as the type itself is private, and the expression should
   ! be deduced as call to an undefined function.