diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.c | 20 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 7 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/associate_38.f90 | 22 |
7 files changed, 56 insertions, 18 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a52932c..8e6c933 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,15 @@ 2018-05-20 Paul Thomas <pault@gcc.gnu.org> + PR fortran/49636 + * trans-array.c (gfc_get_array_span): Renamed from + 'get_array_span'. + (gfc_conv_expr_descriptor): Change references to above. + * trans-array.h : Add prototype for 'gfc_get_array_span'. + * trans-stmt.c (trans_associate_var): If the associate name is + a subref array pointer, use gfc_get_array_span for the span. + +2018-05-20 Paul Thomas <pault@gcc.gnu.org> + PR fortran/82275 * match.c (gfc_match_type_spec): Go through the array ref and decrement 'rank' for every dimension that is an element. diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index cf4b23f..7e6cea1 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -817,8 +817,8 @@ is_pointer_array (tree expr) /* Return the span of an array. */ -static tree -get_array_span (tree desc, gfc_expr *expr) +tree +gfc_get_array_span (tree desc, gfc_expr *expr) { tree tmp; @@ -7061,7 +7061,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) subref_array_target, expr); /* ....and set the span field. */ - tmp = get_array_span (desc, expr); + tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) @@ -7334,7 +7334,7 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) parmtype = TREE_TYPE (parm); /* ....and set the span field. */ - tmp = get_array_span (desc, expr); + tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); } else diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index d7c3254..5ef8656 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -136,6 +136,8 @@ void gfc_conv_tmp_array_ref (gfc_se * se); /* Translate a reference to an array temporary. */ void gfc_conv_tmp_ref (gfc_se *); +/* Obtain the span of an array. */ +tree gfc_get_array_span (tree, gfc_expr *); /* Evaluate an array expression. */ void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *); /* Convert an array for passing as an actual function parameter. */ diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 651a97f..fa01971 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4966,7 +4966,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, enum tree_code op) else { tree ifbody2, elsebody2; - + /* We switch to > or >= depending on the value of the BACK argument. */ cond = gfc_create_var (logical_type_node, "cond"); @@ -7900,15 +7900,17 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) logical_type_node, tmp, build_int_cst (TREE_TYPE (tmp), 0)); - /* A pointer to an array, call library function _gfor_associated. */ - arg1se.want_pointer = 1; - gfc_conv_expr_descriptor (&arg1se, arg1->expr); + /* A pointer to an array, call library function _gfor_associated. */ + arg1se.want_pointer = 1; + gfc_conv_expr_descriptor (&arg1se, arg1->expr); + gfc_add_block_to_block (&se->pre, &arg1se.pre); + gfc_add_block_to_block (&se->post, &arg1se.post); - arg2se.want_pointer = 1; - gfc_conv_expr_descriptor (&arg2se, arg2->expr); - gfc_add_block_to_block (&se->pre, &arg2se.pre); - gfc_add_block_to_block (&se->post, &arg2se.post); - se->expr = build_call_expr_loc (input_location, + arg2se.want_pointer = 1; + gfc_conv_expr_descriptor (&arg2se, arg2->expr); + gfc_add_block_to_block (&se->pre, &arg2se.pre); + gfc_add_block_to_block (&se->post, &arg2se.post); + se->expr = build_call_expr_loc (input_location, gfor_fndecl_associated, 2, arg1se.expr, arg2se.expr); se->expr = convert (logical_type_node, se->expr); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 1952f6c..cc1a429 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -1735,11 +1735,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) if (sym->attr.subref_array_pointer) { gcc_assert (e->expr_type == EXPR_VARIABLE); - tmp = e->symtree->n.sym->ts.type == BT_CLASS - ? gfc_class_data_get (e->symtree->n.sym->backend_decl) - : e->symtree->n.sym->backend_decl; - tmp = gfc_get_element_type (TREE_TYPE (tmp)); - tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); + tmp = gfc_get_array_span (se.expr, e); + gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3726611..b919b84 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2018-05-20 Paul Thomas <pault@gcc.gnu.org> + PR fortran/49636 + * gfortran.dg/associate_38.f90: New test. + +2018-05-20 Paul Thomas <pault@gcc.gnu.org> + PR fortran/82923 * gfortran.dg/select_type_42.f90: New test. diff --git a/gcc/testsuite/gfortran.dg/associate_38.f90 b/gcc/testsuite/gfortran.dg/associate_38.f90 new file mode 100644 index 0000000..27a6f4b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_38.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! +! Test the fix for PR49636 in which the 'span' of 'ty1' was not used +! in the descriptor of 'i'. +! +! Contributed by Fred Krogh <fkrogh#gcc@mathalacarte.com> +! +program test + type ty1 + integer :: k + integer :: i + end type ty1 + type ty2 + type(ty1) :: j(3) + end type ty2 + + type(ty2) t2 + t2%j(1:3)%i = [ 1, 3, 5 ] + associate (i=>t2%j%i) + if (any (t2%j(1:3)%i .ne. i(1:3))) stop 1 + end associate +end program test |