From cedf8d2ee7cf8bb3a5d4d3fe480b257110c0debb Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Sun, 10 Feb 2019 15:52:38 +0000 Subject: [PATCH] re PR fortran/71723 ([F08] ICE on invalid pointer initialization) 2019-02-10 Thomas Koenig PR fortran/71237 * expr.c (gfc_check_assign): Add argument is_init_expr. If we are looking at an init expression, issue error if the target is not a TARGET and we are not looking at a procedure pointer. * gfortran.h (gfc_check_assign): Add optional argument is_init_expr. 2019-02-10 Thomas Koenig PR fortran/71237 * gfortran.dg/pointer_init_2.f90: Adjust error messages. * gfortran.dg/pointer_init_6.f90: Likewise. * gfortran.dg/pointer_init_9.f90: New test. From-SVN: r268748 --- gcc/fortran/ChangeLog | 9 +++++ gcc/fortran/expr.c | 36 ++++++++++++++++---- gcc/fortran/gfortran.h | 3 +- gcc/testsuite/ChangeLog | 9 ++++- gcc/testsuite/gfortran.dg/pointer_init_2.f90 | 4 +-- gcc/testsuite/gfortran.dg/pointer_init_6.f90 | 2 +- gcc/testsuite/gfortran.dg/pointer_init_9.f90 | 13 +++++++ 7 files changed, 65 insertions(+), 11 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pointer_init_9.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b5a4c0a2f64..73c42796fba 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2019-02-10 Thomas Koenig + + PR fortran/71237 + * expr.c (gfc_check_assign): Add argument is_init_expr. If we are + looking at an init expression, issue error if the target is not a + TARGET and we are not looking at a procedure pointer. + * gfortran.h (gfc_check_assign): Add optional argument + is_init_expr. + 2019-02-09 Harald Anlauf PR fortran/89077 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index a0eb94fbbcc..c3d78d358cf 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3691,7 +3691,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, - bool suppress_type_test) + bool suppress_type_test, bool is_init_expr) { symbol_attribute attr, lhs_attr; gfc_ref *ref; @@ -4133,11 +4133,35 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, return false; } - if (!attr.target && !attr.pointer) + if (is_init_expr) { - gfc_error ("Pointer assignment target is neither TARGET " - "nor POINTER at %L", &rvalue->where); - return false; + gfc_symbol *sym; + bool target; + + gcc_assert (rvalue->symtree); + sym = rvalue->symtree->n.sym; + + if (sym->ts.type == BT_CLASS && sym->attr.class_ok) + target = CLASS_DATA (sym)->attr.target; + else + target = sym->attr.target; + + if (!target && !proc_pointer) + { + gfc_error ("Pointer assignment target in initialization expression " + "does not have the TARGET attribute at %L", + &rvalue->where); + return false; + } + } + else + { + if (!attr.target && !attr.pointer) + { + gfc_error ("Pointer assignment target is neither TARGET " + "nor POINTER at %L", &rvalue->where); + return false; + } } if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym)) @@ -4271,7 +4295,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) } if (pointer || proc_pointer) - r = gfc_check_pointer_assign (&lvalue, rvalue); + r = gfc_check_pointer_assign (&lvalue, rvalue, false, true); else { /* If a conversion function, e.g., __convert_i8_i4, was inserted diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 9643deba129..0a0fef81d9f 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3247,7 +3247,8 @@ int gfc_kind_max (gfc_expr *, gfc_expr *); bool gfc_check_conformance (gfc_expr *, gfc_expr *, const char *, ...) ATTRIBUTE_PRINTF_3; bool gfc_check_assign (gfc_expr *, gfc_expr *, int, bool c = true); bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, - bool suppres_type_test = false); + bool suppres_type_test = false, + bool is_init_expr = false); bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 789f5ad3c91..c70ec9f2704 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,14 @@ +2019-02-10 Thomas Koenig + + PR fortran/71237 + * gfortran.dg/pointer_init_2.f90: Adjust error messages. + * gfortran.dg/pointer_init_6.f90: Likewise. + * gfortran.dg/pointer_init_9.f90: New test. + 2019-02-10 Thomas Koenig PR fortran/67679 - * gfortran.dg/warn_undefined_1.f90: New test. + * gfortran.dg/warn_undefined_1.f90: New test.o 2019-02-10 Jakub Jelinek diff --git a/gcc/testsuite/gfortran.dg/pointer_init_2.f90 b/gcc/testsuite/gfortran.dg/pointer_init_2.f90 index a280a3e4f98..bc1ef74ec55 100644 --- a/gcc/testsuite/gfortran.dg/pointer_init_2.f90 +++ b/gcc/testsuite/gfortran.dg/pointer_init_2.f90 @@ -18,7 +18,7 @@ subroutine sub integer, pointer :: dp0 => 13 ! { dg-error "Error in pointer initialization" } integer, pointer :: dp1 => r ! { dg-error "Different types in pointer assignment" } integer, pointer :: dp2 => v ! { dg-error "Different ranks in pointer assignment" } - integer, pointer :: dp3 => i ! { dg-error "is neither TARGET nor POINTER" } + integer, pointer :: dp3 => i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" } integer, pointer :: dp4 => j ! { dg-error "must have the SAVE attribute" } integer, pointer :: dp5 => a ! { dg-error "must not be ALLOCATABLE" } @@ -35,7 +35,7 @@ subroutine sub end type t3 type t4 - integer, pointer :: dpc3 => i ! { dg-error "Pointer assignment target is neither TARGET nor POINTER" } + integer, pointer :: dpc3 => i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" } end type t4 type t5 diff --git a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 b/gcc/testsuite/gfortran.dg/pointer_init_6.f90 index f5e7555c4a7..3abad4ae179 100644 --- a/gcc/testsuite/gfortran.dg/pointer_init_6.f90 +++ b/gcc/testsuite/gfortran.dg/pointer_init_6.f90 @@ -13,7 +13,7 @@ module m1 integer, target :: i type(t), target :: x integer, pointer :: p1 => i - integer, pointer :: p2 => p1 ! { dg-error "must have the TARGET attribute" } + integer, pointer :: p2 => p1 ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute at" } integer, pointer :: p3 => x%p ! { dg-error "must have the TARGET attribute" } integer, pointer :: p4 => x%i integer, pointer :: p5 => u ! { dg-error "has no IMPLICIT type" } diff --git a/gcc/testsuite/gfortran.dg/pointer_init_9.f90 b/gcc/testsuite/gfortran.dg/pointer_init_9.f90 new file mode 100644 index 00000000000..da00330e536 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pointer_init_9.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! PR 71237 - this used to ICE. +module data_mod + implicit none + + type data_t + integer :: i + end type + + type(data_t), pointer :: data + integer, pointer :: idata => data%i ! { dg-error "Pointer assignment target in initialization expression does not have the TARGET attribute" } + +end module