Commit 8451584a by Erik Edelmann Committed by Tobias Schlüter

re PR fortran/23843 (Access restrictions on derived types in modules too strict.)

fortran/
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.
testsuite/
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.

Co-Authored-By: Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>

From-SVN: r104542
parent 6445dc54
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
......
......@@ -2518,6 +2518,29 @@ derived_pointer (gfc_symbol * sym)
}
/* 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. */
......@@ -3184,7 +3207,8 @@ resolve_select (gfc_code * code)
/* 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
......@@ -3219,7 +3243,7 @@ resolve_transfer (gfc_code * code)
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
! { 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
! PR23843
! Make sure derived type I/O with PRIVATE components works where it's allowed
module m1
type t1
integer i
end type t1
end module m1
module m2
use m1
type t2
private
type (t1) t
end type t2
type t3
private
integer i
end type t3
contains
subroutine test
character*20 c
type(t2) :: a
type(t3) :: b
a % t % i = 31337
b % i = 255
write(c,*) a
if (trim(adjustl(c)) /= "31337") call abort
write(c,*) b
if (trim(adjustl(c)) /= "255") call abort
end subroutine test
end module m2
use m2
call test
end
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