From: Paul Thomas Date: Sun, 29 Sep 2019 10:12:42 +0000 (+0000) Subject: re PR fortran/91726 (ICE in gfc_conv_array_ref, at fortran/trans-array.c:3612) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=56b070e3bbc4364f86357d6651fe1391464db6d6;p=gcc.git re PR fortran/91726 (ICE in gfc_conv_array_ref, at fortran/trans-array.c:3612) 2019-09-29 Paul Thomas PR fortran/91726 * resolve.c (gfc_expr_to_initialize): Bail out with a copy of the original expression if the array ref is a scalar and the array_spec has corank. * trans-array.c (gfc_conv_array_ref): Such expressions are OK even if the array ref codimen is zero. * trans-expr.c (gfc_get_class_from_expr): New function taken from gfc_get_vptr_from_expr. (gfc_get_vptr_from_expr): Call new function. * trans-stmt.c (trans_associate_var): If one of these is a target expression, extract the class expression from the target and copy its fields to a new target variable. * trans.h : Add prototype for gfc_get_class_from_expr. 2019-09-29 Paul Thomas PR fortran/91726 * gfortran.dg/coarray_poly_9.f90 : New test. From-SVN: r276269 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0b870066b66..8fc562531c9 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2019-09-29 Paul Thomas + + PR fortran/91726 + * resolve.c (gfc_expr_to_initialize): Bail out with a copy of + the original expression if the array ref is a scalar and the + array_spec has corank. + * trans-array.c (gfc_conv_array_ref): Such expressions are OK + even if the array ref codimen is zero. + * trans-expr.c (gfc_get_class_from_expr): New function taken + from gfc_get_vptr_from_expr. + (gfc_get_vptr_from_expr): Call new function. + * trans-stmt.c (trans_associate_var): If one of these is a + target expression, extract the class expression from the target + and copy its fields to a new target variable. + * trans.h : Add prototype for gfc_get_class_from_expr. + 2019-09-28 Jerry DeLisle PR fortran/91802 @@ -14,7 +30,7 @@ PR fortran/91864 * gcc/fortran/io.c (match_io_element): An inquiry parameter cannot be read into. - * gcc/fortran/match.c (gfc_match_allocate): An inquiry parameter + * gcc/fortran/match.c (gfc_match_allocate): An inquiry parameter can be neither an allocate-object nor stat variable. (gfc_match_deallocate): An inquiry parameter cannot be deallocated. diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f1de7dd76c6..e8d05662514 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -7433,6 +7433,10 @@ gfc_expr_to_initialize (gfc_expr *e) for (ref = result->ref; ref; ref = ref->next) if (ref->type == REF_ARRAY && ref->next == NULL) { + if (ref->u.ar.dimen == 0 + && ref->u.ar.as && ref->u.ar.as->corank) + return result; + ref->u.ar.type = AR_FULL; for (i = 0; i < ref->u.ar.dimen; i++) diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 07c4d7e671f..437892a6abf 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -3609,7 +3609,8 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr, if (ar->dimen == 0) { - gcc_assert (ar->codimen || sym->attr.select_rank_temporary); + gcc_assert (ar->codimen || sym->attr.select_rank_temporary + || (ar->as && ar->as->corank)); if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr))) se->expr = build_fold_indirect_ref (gfc_conv_array_data (se->expr)); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 2adc112bcec..61db4e39210 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -472,11 +472,11 @@ gfc_reset_len (stmtblock_t *block, gfc_expr *expr) } -/* Obtain the vptr of the last class reference in an expression. +/* Obtain the last class reference in an expression. Return NULL_TREE if no class reference is found. */ tree -gfc_get_vptr_from_expr (tree expr) +gfc_get_class_from_expr (tree expr) { tree tmp; tree type; @@ -487,7 +487,7 @@ gfc_get_vptr_from_expr (tree expr) while (type) { if (GFC_CLASS_TYPE_P (type)) - return gfc_class_vptr_get (tmp); + return tmp; if (type != TYPE_CANONICAL (type)) type = TYPE_CANONICAL (type); else @@ -501,6 +501,23 @@ gfc_get_vptr_from_expr (tree expr) tmp = build_fold_indirect_ref_loc (input_location, tmp); if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))) + return tmp; + + return NULL_TREE; +} + + +/* Obtain the vptr of the last class reference in an expression. + Return NULL_TREE if no class reference is found. */ + +tree +gfc_get_vptr_from_expr (tree expr) +{ + tree tmp; + + tmp = gfc_get_class_from_expr (expr); + + if (tmp != NULL_TREE) return gfc_class_vptr_get (tmp); return NULL_TREE; diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 856a171abf4..e3ea38a9aa1 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -2099,7 +2099,43 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) } else { + tree ctree = gfc_get_class_from_expr (se.expr); tmp = TREE_TYPE (sym->backend_decl); + + /* Coarray scalar component expressions can emerge from + the front end as array elements of the _data field. */ + if (sym->ts.type == BT_CLASS + && e->ts.type == BT_CLASS && e->rank == 0 + && !GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)) && ctree) + { + tree stmp; + tree dtmp; + + se.expr = ctree; + dtmp = TREE_TYPE (TREE_TYPE (sym->backend_decl)); + ctree = gfc_create_var (dtmp, "class"); + + stmp = gfc_class_data_get (se.expr); + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (stmp))); + + /* Set the fields of the target class variable. */ + stmp = gfc_conv_descriptor_data_get (stmp); + dtmp = gfc_class_data_get (ctree); + stmp = fold_convert (TREE_TYPE (dtmp), stmp); + gfc_add_modify (&se.pre, dtmp, stmp); + stmp = gfc_class_vptr_get (se.expr); + dtmp = gfc_class_vptr_get (ctree); + stmp = fold_convert (TREE_TYPE (dtmp), stmp); + gfc_add_modify (&se.pre, dtmp, stmp); + if (UNLIMITED_POLY (sym)) + { + stmp = gfc_class_len_get (se.expr); + dtmp = gfc_class_len_get (ctree); + stmp = fold_convert (TREE_TYPE (dtmp), stmp); + gfc_add_modify (&se.pre, dtmp, stmp); + } + se.expr = ctree; + } tmp = gfc_build_addr_expr (tmp, se.expr); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 84793dc1df0..6ebb71de152 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -442,6 +442,7 @@ tree gfc_vptr_final_get (tree); tree gfc_vptr_deallocate_get (tree); void gfc_reset_vptr (stmtblock_t *, gfc_expr *); void gfc_reset_len (stmtblock_t *, gfc_expr *); +tree gfc_get_class_from_expr (tree); tree gfc_get_vptr_from_expr (tree); tree gfc_get_class_array_ref (tree, tree, tree, bool); tree gfc_copy_class_to_class (tree, tree, tree, bool); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d0d2cb084c5..a23c7286a6d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-09-29 Paul Thomas + + PR fortran/91726 + * gfortran.dg/coarray_poly_9.f90 : New test. + 2019-09-29 Kewen Lin * gcc.target/powerpc/conv-vectorize-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/coarray_poly_9.f90 b/gcc/testsuite/gfortran.dg/coarray_poly_9.f90 new file mode 100644 index 00000000000..ea2a9422ceb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_poly_9.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! +! Test the fix for PR91726. +! +! Contributed by Gerhardt Steinmetz +! +module m + type s + class(*), allocatable :: a[:] ! This ICEd + end type + type t + class(*), allocatable :: a(:)[:] ! This was OK + end type +end + + use m + call foo + call bar +contains + subroutine foo + type (s) :: a + integer(4) :: i = 42_4 + allocate (a%a[*], source = i) ! This caused runtime segfaults + select type (z => a%a) ! ditto + type is (integer(4)) + if (z .ne. 42_4) stop 1 + end select + end subroutine + subroutine bar ! Arrays always worked + type (t) :: a + allocate (a%a(3)[*], source = [1_4, 2_4, 3_4]) + select type (z => a%a) + type is (integer(4)) + if (any (z .ne. [1_4, 2_4, 3_4])) stop 2 + end select + end subroutine +end