re PR fortran/49636 ([F03] ASSOCIATE construct confused with slightly complicated...

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/49636
	* gfortran.dg/associate_38.f90: New test.

From-SVN: r260414

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a52932c..8e6c933 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
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