From 8451584a84b785b5e7bd09de1a7b886fc2ebfd81 Mon Sep 17 00:00:00 2001 From: Erik Edelmann Date: Fri, 23 Sep 2005 00:52:09 +0300 Subject: [PATCH] re PR fortran/23843 (Access restrictions on derived types in modules too strict.) MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit fortran/ 2005-09-22 Erik Edelmann PR fortran/23843 * resolve.c (derived_inaccessible): New function. (resolve_transfer): Use it to check for private components. testsuite/ 2005-09-22 Erik Edelmann Tobias Schl"uter PR fortran/23843 * gfortran.dg/der_io_2.f90, gfortran.dg/der_io_3.f90: New test. Co-Authored-By: Tobias Schlüter From-SVN: r104542 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/resolve.c | 28 ++++++++++++- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/der_io_2.f90 | 55 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/der_io_3.f90 | 40 +++++++++++++++++++ 5 files changed, 134 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/der_io_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/der_io_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e6c8da192ad..76b52e8dbee 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2005-09-22 Erik Edelmann + + PR fortran/23843 + * resolve.c (derived_inaccessible): New function. + (resolve_transfer): Use it to check for private + components. + 2005-09-22 Steven G. Kargl PR fortran/23516 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e342a1e8d57..88e7d185280 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6277f2fcc77..ab82adcf84d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2005-09-22 Erik Edelmann + Tobias Schl"uter + + PR fortran/23843 + * gfortran.dg/der_io_2.f90, gfortran.dg/der_io_3.f90: New test. + 2005-09-22 Steven G. Kargl PR fortran/23516 diff --git a/gcc/testsuite/gfortran.dg/der_io_2.f90 b/gcc/testsuite/gfortran.dg/der_io_2.f90 new file mode 100644 index 00000000000..08afc02fd40 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/der_io_2.f90 @@ -0,0 +1,55 @@ +! { 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 + + diff --git a/gcc/testsuite/gfortran.dg/der_io_3.f90 b/gcc/testsuite/gfortran.dg/der_io_3.f90 new file mode 100644 index 00000000000..5fdc7245422 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/der_io_3.f90 @@ -0,0 +1,40 @@ +! 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 -- 2.30.2