re PR fortran/49636 ([F03] ASSOCIATE construct confused with slightly complicated...
authorPaul Thomas <pault@gcc.gnu.org>
Sun, 20 May 2018 10:04:46 +0000 (10:04 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sun, 20 May 2018 10:04:46 +0000 (10:04 +0000)
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

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-array.h
gcc/fortran/trans-intrinsic.c
gcc/fortran/trans-stmt.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/associate_38.f90 [new file with mode: 0644]

index a52932c103fa1727674bc2abefed2e5967319acd..8e6c933d7c71fb46cc150c1f8aac79dbce386507 100644 (file)
@@ -1,3 +1,13 @@
+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
index cf4b23f4391af1f5c9d882f46eef77f101603046..7e6cea15c6a00942f53434cf244dc8da7a174cd1 100644 (file)
@@ -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
index d7c32540a82e31759f346ea915e2c09dd028d3e9..5ef86565d8d09aba3c927962ba19172a9e05fede 100644 (file)
@@ -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.  */
index 651a97f1d3f73d9fa34ca83aba8de544836eaf74..fa0197162921e011191997759591b529eb45864e 100644 (file)
@@ -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);
index 1952f6cdc0847fb6b945cddb9dab469291187dd3..cc1a42943277328efbcfc109d6582c186bb25c14 100644 (file)
@@ -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);
        }
 
index 372661152ccabdb4be63817b283f6c124ae43820..b919b842aa85a6c5aaa781001ccef3453c9ef56f 100644 (file)
@@ -1,3 +1,8 @@
+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
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
@@ -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