From: Thomas Koenig Date: Sun, 10 Feb 2019 18:41:03 +0000 (+0000) Subject: re PR fortran/71723 ([F08] ICE on invalid pointer initialization) X-Git-Tag: releases/gcc-7.5.0~596 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=ddcb4f31c9fe554b540255b4562504ac176ef01e;p=thirdparty%2Fgcc.git re PR fortran/71723 ([F08] ICE on invalid pointer initialization) 2019-02-10 Thomas Koenig PR fortran/71723 Backport from trunk * 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/71723 Backport from trunk * 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: r268751 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0cb5e48d527d..282d863655c2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2019-02-10 Thomas Koenig + + PR fortran/71723 + Backport from trunk + * 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-05 Thomas Koenig PR fortran/67679 diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index ab997af59776..09401a4c3394 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -3342,7 +3342,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform, NULLIFY statement. */ bool -gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) +gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, bool is_init_expr) { symbol_attribute attr, lhs_attr; gfc_ref *ref; @@ -3773,11 +3773,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)) @@ -3903,7 +3927,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, 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 c0bb9b5d4909..23881076e2f9 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3127,7 +3127,7 @@ 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 *, gfc_expr *); +bool gfc_check_pointer_assign (gfc_expr *, gfc_expr *, 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 83b35d3e895d..7397586bdb86 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-02-10 Thomas Koenig + + PR fortran/71723 + Backport from trunk + * 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-09 Thomas Koenig PR fortran/71860 diff --git a/gcc/testsuite/gfortran.dg/pointer_init_2.f90 b/gcc/testsuite/gfortran.dg/pointer_init_2.f90 index a280a3e4f989..bc1ef74ec559 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 f5e7555c4a77..3abad4ae1795 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 000000000000..da00330e5366 --- /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