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

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

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