From: pault Date: Mon, 20 Apr 2009 21:55:26 +0000 (+0000) Subject: 2009-04-20 Paul Thomas X-Git-Tag: upstream/4.9.2~36594 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9386f3435d09dd0c757eef506b16b93229a47cd3;p=platform%2Fupstream%2Flinaro-gcc.git 2009-04-20 Paul Thomas PR fortran/39800 * resolve.c (is_sym_host_assoc): New function. (resolve_fl_derived): Call it when checking PRIVATE components of PUBLIC derived types. Change gfc_error to a gfc_notify_std with std=f2003. (resolve_fl_namelist): Call it twice to check for host association. 2009-04-20 Paul Thomas PR fortran/39800 * gfortran.dg/private_type_13.f90: New test. * gfortran.dg/private_type_2.f90: Add option -std=f95. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@146457 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 37349b7..d230333 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2009-04-20 Paul Thomas + + PR fortran/39800 + * resolve.c (is_sym_host_assoc): New function. + (resolve_fl_derived): Call it when checking PRIVATE components + of PUBLIC derived types. Change gfc_error to a gfc_notify_std + with std=f2003. + (resolve_fl_namelist): Call it twice to check for host + association. + 2009-04-20 Ian Lance Taylor * module.c (import_iso_c_binding_module): Add casts to enum type. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index fad067c..f214050 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -83,6 +83,18 @@ gfc_is_formal_arg (void) return formal_arg_flag; } +/* Is the symbol host associated? */ +static bool +is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns) +{ + for (ns = ns->parent; ns; ns = ns->parent) + { + if (sym->ns == ns) + return true; + } + + return false; +} /* Ensure a typespec used is valid; for instance, TYPE(t) is invalid if t is an ABSTRACT derived-type. If where is not NULL, an error message with that @@ -8895,13 +8907,15 @@ resolve_fl_derived (gfc_symbol *sym) if (c->ts.type == BT_DERIVED && sym->component_access != ACCESS_PRIVATE && gfc_check_access (sym->attr.access, sym->ns->default_access) + && !is_sym_host_assoc (c->ts.derived, sym->ns) && !c->ts.derived->attr.use_assoc && !gfc_check_access (c->ts.derived->attr.access, c->ts.derived->ns->default_access)) { - gfc_error ("The component '%s' is a PRIVATE type and cannot be " - "a component of '%s', which is PUBLIC at %L", - c->name, sym->name, &sym->declared_at); + gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' " + "is a PRIVATE type and cannot be a component of " + "'%s', which is PUBLIC at %L", c->name, + sym->name, &sym->declared_at); return FAILURE; } @@ -8989,9 +9003,7 @@ resolve_fl_namelist (gfc_symbol *sym) for (nl = sym->namelist; nl; nl = nl->next) { if (!nl->sym->attr.use_assoc - && !(sym->ns->parent == nl->sym->ns) - && !(sym->ns->parent - && sym->ns->parent->parent == nl->sym->ns) + && !is_sym_host_assoc (nl->sym, sym->ns) && !gfc_check_access(nl->sym->attr.access, nl->sym->ns->default_access)) { @@ -9013,7 +9025,7 @@ resolve_fl_namelist (gfc_symbol *sym) /* Types with private components that are defined in the same module. */ if (nl->sym->ts.type == BT_DERIVED - && !(sym->ns->parent == nl->sym->ts.derived->ns) + && !is_sym_host_assoc (nl->sym->ts.derived, sym->ns) && !gfc_check_access (nl->sym->ts.derived->attr.private_comp ? ACCESS_PRIVATE : ACCESS_UNKNOWN, nl->sym->ns->default_access)) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c589673..a68a44f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2009-04-20 Paul Thomas + + PR fortran/39800 + * gfortran.dg/private_type_13.f90: New test. + * gfortran.dg/private_type_2.f90: Add option -std=f95. + 2009-04-20 Le-Chun Wu PR c++/39803 diff --git a/gcc/testsuite/gfortran.dg/private_type_13.f90 b/gcc/testsuite/gfortran.dg/private_type_13.f90 new file mode 100644 index 0000000..77c41a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/private_type_13.f90 @@ -0,0 +1,32 @@ +! { dg-do compile } +! Test fix for F95 part of PR39800, in which the host association of the type 't1' +! generated an error. +! +! Reported to clf by Alexei Matveev and reported by +! Tobias Burnus +! +module m + implicit none + private + + type :: t1 + integer :: i + end type + + type :: t2 + type(t1) :: j + end type + + contains + + subroutine sub() + implicit none + + type :: t3 + type(t1) :: j + end type + + end subroutine + +end module +! { dg-final { cleanup-modules "m" } } diff --git a/gcc/testsuite/gfortran.dg/private_type_2.f90 b/gcc/testsuite/gfortran.dg/private_type_2.f90 index 690be5d..cda00ca 100644 --- a/gcc/testsuite/gfortran.dg/private_type_2.f90 +++ b/gcc/testsuite/gfortran.dg/private_type_2.f90 @@ -1,8 +1,11 @@ ! { dg-do compile } +! { dg-options "-std=f95" } ! PR16404 test 6 - If a component of a derived type is of a type declared to ! be private, either the derived type definition must contain the PRIVATE ! statement, or the derived type must be private. ! Modified on 20051105 to test PR24534. +! Modified on 20090419 to use -std=f95, since F2003 allows public types +! with private components. ! ! Contributed by Joost VandeVondele MODULE TEST