+2005-09-22 Erik Edelmann <erik.edelmann@iki.fi>
+
+ PR fortran/23843
+ * resolve.c (derived_inaccessible): New function.
+ (resolve_transfer): Use it to check for private
+ components.
+
2005-09-22 Steven G. Kargl <kargls@comcast.net>
PR fortran/23516
}
+/* Given a pointer to a symbol that is a derived type, see if it's
+ inaccessible, i.e. if it's defined in another module and the components are
+ PRIVATE. The search is recursive if necessary. Returns zero if no
+ inaccessible components are found, nonzero otherwise. */
+
+static int
+derived_inaccessible (gfc_symbol *sym)
+{
+ gfc_component *c;
+
+ if (sym->attr.use_assoc && sym->component_access == ACCESS_PRIVATE)
+ return 1;
+
+ for (c = sym->components; c; c = c->next)
+ {
+ if (c->ts.type == BT_DERIVED && derived_inaccessible (c->ts.derived))
+ return 1;
+ }
+
+ return 0;
+}
+
+
/* Resolve the argument of a deallocate expression. The expression must be
a pointer or a full array. */
/* Resolve a transfer statement. This is making sure that:
-- a derived type being transferred has only non-pointer components
- -- a derived type being transferred doesn't have private components
+ -- a derived type being transferred doesn't have private components, unless
+ it's being transferred from the module where the type was defined
-- we're not trying to transfer a whole assumed size array. */
static void
return;
}
- if (ts->derived->component_access == ACCESS_PRIVATE)
+ if (derived_inaccessible (ts->derived))
{
gfc_error ("Data transfer element at %L cannot have "
"PRIVATE components",&code->loc);
+2005-09-22 Erik Edelmann <erik.edelmann@iki.fi>
+ Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/23843
+ * gfortran.dg/der_io_2.f90, gfortran.dg/der_io_3.f90: New test.
+
2005-09-22 Steven G. Kargl <kargls@comcast.net>
PR fortran/23516
--- /dev/null
+! { dg-do compile }
+! PR 23843
+! IO of derived types with private components is allowed in the module itself,
+! but not elsewhere
+module gfortran2
+ type :: tp1
+ private
+ integer :: i
+ end type tp1
+
+ type :: tp1b
+ integer :: i
+ end type tp1b
+
+ type :: tp2
+ real :: a
+ type(tp1) :: t
+ end type tp2
+
+contains
+
+ subroutine test()
+ type(tp1) :: x
+ type(tp2) :: y
+
+ write (*, *) x
+ write (*, *) y
+ end subroutine test
+
+end module gfortran2
+
+program prog
+
+ use gfortran2
+
+ implicit none
+ type :: tp3
+ type(tp2) :: t
+ end type tp3
+ type :: tp3b
+ type(tp1b) :: t
+ end type tp3b
+
+ type(tp1) :: x
+ type(tp2) :: y
+ type(tp3) :: z
+ type(tp3b) :: zb
+
+ write (*, *) x ! { dg-error "PRIVATE components" }
+ write (*, *) y ! { dg-error "PRIVATE components" }
+ write (*, *) z ! { dg-error "PRIVATE components" }
+ write (*, *) zb
+end program prog
+
+