From 9cbf8673106e24e33f2ab2ed9a054c3a759d84e1 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Sun, 13 Nov 2016 10:56:10 +0100 Subject: [PATCH] re PR fortran/66366 ([OOP] ICE on invalid with non-allocatable CLASS variable) 2016-11-13 Janus Weil PR fortran/66366 * resolve.c (resolve_component): Move check for C437 to ... * decl.c (build_struct): ... here. Fix indentation. 2016-11-13 Janus Weil PR fortran/66366 * gfortran.dg/class_57.f90: Changed error message. * gfortran.dg/class_60.f90: New test. From-SVN: r242351 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/decl.c | 13 ++++++++-- gcc/fortran/resolve.c | 13 ---------- gcc/testsuite/ChangeLog | 6 +++++ gcc/testsuite/gfortran.dg/class_57.f90 | 2 +- gcc/testsuite/gfortran.dg/class_60.f90 | 33 ++++++++++++++++++++++++++ 6 files changed, 58 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_60.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6e0b654eb0e..a9db062b4ab 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-11-13 Janus Weil + + PR fortran/66366 + * resolve.c (resolve_component): Move check for C437 + to ... + * decl.c (build_struct): ... here. Fix indentation. + 2016-11-12 Janus Weil PR fortran/77501 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index b17a8aa7da2..4f5c0cfa4ac 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1866,9 +1866,18 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, } else if (current_attr.allocatable == 0) { - gfc_error ("Component at %C must have the POINTER attribute"); - return false; + gfc_error ("Component at %C must have the POINTER attribute"); + return false; + } } + + /* F03:C437. */ + if (current_ts.type == BT_CLASS + && !(current_attr.pointer || current_attr.allocatable)) + { + gfc_error ("Component %qs with CLASS at %C must be allocatable " + "or pointer", name); + return false; } if (gfc_current_block ()->attr.pointer && (*as)->rank != 0) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index faf7dde4183..c85525aabb9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13587,19 +13587,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym) return false; } - /* C437. */ - if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE - && (!c->attr.class_ok - || !(CLASS_DATA (c)->attr.class_pointer - || CLASS_DATA (c)->attr.allocatable))) - { - gfc_error ("Component %qs with CLASS at %L must be allocatable " - "or pointer", c->name, &c->loc); - /* Prevent a recurrence of the error. */ - c->ts.type = BT_UNKNOWN; - return false; - } - /* If an allocatable component derived type is of the same type as the enclosing derived type, we need a vtable generating so that the __deallocate procedure is created. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 844b4b8bd32..65fbaad34f9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2016-11-13 Janus Weil + + PR fortran/66366 + * gfortran.dg/class_57.f90: Changed error message. + * gfortran.dg/class_60.f90: New test. + 2016-11-12 David Edelsohn * g++.dg/pr78112.C: XFAIL AIX. diff --git a/gcc/testsuite/gfortran.dg/class_57.f90 b/gcc/testsuite/gfortran.dg/class_57.f90 index 7256dfc4d29..8104338672b 100644 --- a/gcc/testsuite/gfortran.dg/class_57.f90 +++ b/gcc/testsuite/gfortran.dg/class_57.f90 @@ -18,7 +18,7 @@ contains function pc(pd) type(p) :: pc class(d), intent(in), target :: pd - pc%cc => pd ! { dg-error "Non-POINTER in pointer association context" } + pc%cc => pd ! { dg-error "is not a member of" } end function end diff --git a/gcc/testsuite/gfortran.dg/class_60.f90 b/gcc/testsuite/gfortran.dg/class_60.f90 new file mode 100644 index 00000000000..f51c48349c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_60.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! +! PR 66366: [OOP] ICE on invalid with non-allocatable CLASS variable +! +! Contributed by Andrew Benson + +module bug + + type :: t1d + contains + procedure :: interpolate => interp + end type t1d + + type :: tff + class(t1d) :: transfer ! { dg-error "must be allocatable or pointer" } + end type tff + +contains + + double precision function interp(self) + implicit none + class(t1d), intent(inout) :: self + return + end function interp + + double precision function fvb(self) + implicit none + class(tff), intent(inout) :: self + fvb=self%transfer%interpolate() ! { dg-error "is not a member of" } + return + end function fvb + +end module bug -- 2.30.2