Commit c867b7b6 by Paul Thomas

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
parent 311fa510
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> 2009-04-20 Ian Lance Taylor <iant@google.com>
* module.c (import_iso_c_binding_module): Add casts to enum type. * module.c (import_iso_c_binding_module): Add casts to enum type.
......
...@@ -83,6 +83,18 @@ gfc_is_formal_arg (void) ...@@ -83,6 +83,18 @@ gfc_is_formal_arg (void)
return formal_arg_flag; 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 /* 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 an ABSTRACT derived-type. If where is not NULL, an error message with that
...@@ -8895,13 +8907,15 @@ resolve_fl_derived (gfc_symbol *sym) ...@@ -8895,13 +8907,15 @@ resolve_fl_derived (gfc_symbol *sym)
if (c->ts.type == BT_DERIVED if (c->ts.type == BT_DERIVED
&& sym->component_access != ACCESS_PRIVATE && sym->component_access != ACCESS_PRIVATE
&& gfc_check_access (sym->attr.access, sym->ns->default_access) && 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 && !c->ts.derived->attr.use_assoc
&& !gfc_check_access (c->ts.derived->attr.access, && !gfc_check_access (c->ts.derived->attr.access,
c->ts.derived->ns->default_access)) c->ts.derived->ns->default_access))
{ {
gfc_error ("The component '%s' is a PRIVATE type and cannot be " gfc_notify_std (GFC_STD_F2003, "Fortran 2003: the component '%s' "
"a component of '%s', which is PUBLIC at %L", "is a PRIVATE type and cannot be a component of "
c->name, sym->name, &sym->declared_at); "'%s', which is PUBLIC at %L", c->name,
sym->name, &sym->declared_at);
return FAILURE; return FAILURE;
} }
...@@ -8989,9 +9003,7 @@ resolve_fl_namelist (gfc_symbol *sym) ...@@ -8989,9 +9003,7 @@ resolve_fl_namelist (gfc_symbol *sym)
for (nl = sym->namelist; nl; nl = nl->next) for (nl = sym->namelist; nl; nl = nl->next)
{ {
if (!nl->sym->attr.use_assoc if (!nl->sym->attr.use_assoc
&& !(sym->ns->parent == nl->sym->ns) && !is_sym_host_assoc (nl->sym, sym->ns)
&& !(sym->ns->parent
&& sym->ns->parent->parent == nl->sym->ns)
&& !gfc_check_access(nl->sym->attr.access, && !gfc_check_access(nl->sym->attr.access,
nl->sym->ns->default_access)) nl->sym->ns->default_access))
{ {
...@@ -9013,7 +9025,7 @@ resolve_fl_namelist (gfc_symbol *sym) ...@@ -9013,7 +9025,7 @@ resolve_fl_namelist (gfc_symbol *sym)
/* Types with private components that are defined in the same module. */ /* Types with private components that are defined in the same module. */
if (nl->sym->ts.type == BT_DERIVED 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 && !gfc_check_access (nl->sym->ts.derived->attr.private_comp
? ACCESS_PRIVATE : ACCESS_UNKNOWN, ? ACCESS_PRIVATE : ACCESS_UNKNOWN,
nl->sym->ns->default_access)) nl->sym->ns->default_access))
......
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.
2009-04-20 Le-Chun Wu <lcwu@google.com> 2009-04-20 Le-Chun Wu <lcwu@google.com>
PR c++/39803 PR c++/39803
......
! { 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 <Alexei Matveev@gmail.com> and reported by
! Tobias Burnus <burnus@gcc.gnu.org>
!
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" } }
! { dg-do compile } ! { dg-do compile }
! { dg-options "-std=f95" }
! PR16404 test 6 - If a component of a derived type is of a type declared to ! 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 ! be private, either the derived type definition must contain the PRIVATE
! statement, or the derived type must be private. ! statement, or the derived type must be private.
! Modified on 20051105 to test PR24534. ! 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 <jv244@cam.ac.uk> ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
MODULE TEST MODULE TEST
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment