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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@156040 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b2741b1..d8e54e1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6bc5fde..8f32d1a 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index a5787de..e363c5e 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a4aafda..8b7c5ee 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/extends_10.f03 b/gcc/testsuite/gfortran.dg/extends_10.f03
new file mode 100644 (file)
index 0000000..fbcaa7e
--- /dev/null
+++ b/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" } }

diff --git a/gcc/testsuite/gfortran.dg/extends_6.f03 b/gcc/testsuite/gfortran.dg/extends_6.f03
index 866fbbd..a50a9b7 100644 (file)
--- a/gcc/testsuite/gfortran.dg/extends_6.f03
+++ b/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" }
 

diff --git a/gcc/testsuite/gfortran.dg/private_type_6.f90 b/gcc/testsuite/gfortran.dg/private_type_6.f90
index 5e13ed5..4af3f70 100644 (file)
--- a/gcc/testsuite/gfortran.dg/private_type_6.f90
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03 b/gcc/testsuite/gfortran.dg/structure_constructor_8.f03
index 520b528..b86d0ec 100644 (file)
--- a/gcc/testsuite/gfortran.dg/structure_constructor_8.f03
+++ b/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.