diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2009-04-20 21:55:26 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2009-04-20 21:55:26 +0000 |
| commit | c867b7b65310c33d124e0c3bfbb62d9a1001874e (patch) | |
| tree | 12ea6f91abb779d2653ae066d97bedced48be5d9 /gcc/fortran | |
| parent | 311fa510e6d737db7727ab6f4bd1c5598f2b217c (diff) | |
| download | gcc-c867b7b65310c33d124e0c3bfbb62d9a1001874e.zip gcc-c867b7b65310c33d124e0c3bfbb62d9a1001874e.tar.gz gcc-c867b7b65310c33d124e0c3bfbb62d9a1001874e.tar.bz2 | |
re PR fortran/39800 (Rejects PRIVATE TYPE as compont of local type declaration)
2009-04-20 Paul Thomas <pault@gcc.gnu.org>
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 <pault@gcc.gnu.org>
PR fortran/39800
* gfortran.dg/private_type_13.f90: New test.
* gfortran.dg/private_type_2.f90: Add option -std=f95.
From-SVN: r146457
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 26 |
2 files changed, 29 insertions, 7 deletions
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 <pault@gcc.gnu.org> + + 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 <iant@google.com> * 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)) |