Patchwork [fortran] Really fix PR 56782

login
register
mail settings
Submitter Thomas Koenig
Date April 14, 2013, 9:57 a.m.
Message ID <516A7D6C.7000801@netcologne.de>
Download mbox | patch
Permalink /patch/236426/
State New
Headers show

Comments

Thomas Koenig - April 14, 2013, 9:57 a.m.
Hello world,

the attached patch completely fixes the regression,
PR 56782.

Regression-tested.  OK for trunk and 4.8?

	Thomas

2013-04-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/56782
         * frontend-passes.c (copy_walk_reduction_arg):  Do not
         call the expression walker with callback_reduction.
         (insert_iterator_function):  New function.
         (callback_reduction):  If an iterator is present, call
         insert_iterator_function and reset the iterator on the
         original array iterator.

2013-04-08  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/56782
         * gfortran.dg/array_constructor_45.f90:  New test.
         * gfortran.dg/array_constructor_46.f90:  New test.
         * gfortran.dg/array_constructor_40.f90:  Adjust number of
         while loops.
Mikael Morin - April 14, 2013, 2:14 p.m.
Hello,

Le 14/04/2013 11:57, Thomas Koenig a écrit :
> Hello world,
> 
> the attached patch completely fixes the regression,
> PR 56782.
>
typo: it's PR 56872 everywhere.

> Regression-tested.  OK for trunk and 4.8?
> 
>     Thomas
> 
> 2013-04-14  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         PR fortran/56782
>         * frontend-passes.c (copy_walk_reduction_arg):  Do not
>         call the expression walker with callback_reduction.
>         (insert_iterator_function):  New function.
>         (callback_reduction):  If an iterator is present, call
>         insert_iterator_function and reset the iterator on the
>         original array iterator.
> 
> 2013-04-08  Thomas Koenig  <tkoenig@gcc.gnu.org>
> 
>         PR fortran/56782
>         * gfortran.dg/array_constructor_45.f90:  New test.
>         * gfortran.dg/array_constructor_46.f90:  New test.
>         * gfortran.dg/array_constructor_40.f90:  Adjust number of
>         while loops.

> Index: fortran/frontend-passes.c
> ===================================================================
> --- fortran/frontend-passes.c	(Revision 197610)
> +++ fortran/frontend-passes.c	(Arbeitskopie)
> @@ -221,8 +221,47 @@ copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn
>        fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
>      }
>  
> -  (void) gfc_expr_walker (&fcn, callback_reduction, NULL);

why remove this?

> +  return fcn;
> +}
>  
> +/* Auxiliary function to create function with an an array expression with
> +   iterator argument.  */
> +
> +static gfc_expr *
> +insert_iterator_function (gfc_expr *e, gfc_expr *fn, gfc_iterator *iterator)
> +{

[...]

> +
> +  if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
> +    fcn = gfc_build_intrinsic_call (current_ns,
> +				    fn->value.function.isym->id,
> +				    fn->value.function.isym->name,
> +				    fn->where, 3, new_expr,
> +				    NULL, NULL);
> +  else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
> +    fcn = gfc_build_intrinsic_call (current_ns,
> +				    fn->value.function.isym->id,
> +				    fn->value.function.isym->name,
> +				    fn->where, 2, new_expr,
> +				    NULL);
> +  else
> +    gfc_internal_error ("Illegal id in insert_iterator_function");

This duplicated code could probably be merged with
copy_walk_reduction_arg.  I think callback_reduction's iterator handling
should happen there as well.
Like this:

copy_walk_reduction_arg (...)
{
  fcn = gfc_copy_expr (c->expr);
  gfc_expr_walker (&fcn, callback_reduction, NULL);
  if (c->iterator)
    {
      /* wrap in array constructor  */
    }

  if (!scalar)
    {
      /* wrap in intrinsic call */
    }

  return ...;
}


Mikael
Thomas Koenig - April 14, 2013, 2:21 p.m.
Hi Mikael,

>>
>> -  (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
>
> why remove this?

Because it is not needed, as the test case _46 shows.  No need
to run this twice, it doesn't get better :-)

It is a leftover from when the callback function returned 1.

   gfc_internal_error ("Illegal id in insert_iterator_function");
>
> This duplicated code could probably be merged with
> copy_walk_reduction_arg.

I thought about it. The reason why I didn't do it was
because the expr to be wrapped inside the call is different.
Another reason was that I didn't get it right when I tried
this approach.
So, I'd rather leave it as is.

I think callback_reduction's iterator handling
> should happen there as well.

Like I said, it is done automatically by the expression
walker.

	Thomas

Patch

Index: fortran/frontend-passes.c
===================================================================
--- fortran/frontend-passes.c	(Revision 197610)
+++ fortran/frontend-passes.c	(Arbeitskopie)
@@ -221,8 +221,47 @@  copy_walk_reduction_arg (gfc_expr *e, gfc_expr *fn
       fcn->symtree->n.sym->attr.access = ACCESS_PRIVATE;
     }
 
-  (void) gfc_expr_walker (&fcn, callback_reduction, NULL);
+  return fcn;
+}
 
+/* Auxiliary function to create function with an an array expression with
+   iterator argument.  */
+
+static gfc_expr *
+insert_iterator_function (gfc_expr *e, gfc_expr *fn, gfc_iterator *iterator)
+{
+  gfc_expr *fcn, *new_expr;
+  gfc_isym_id id;
+  gfc_constructor_base newbase;
+  gfc_constructor *new_c;
+
+  newbase = NULL;
+  new_expr = gfc_get_expr ();
+  new_expr->expr_type = EXPR_ARRAY;
+  new_expr->ts = e->ts;
+  new_expr->where = e->where;
+  new_expr->rank = 1;
+  new_c = gfc_constructor_append_expr (&newbase, gfc_copy_expr(e), &(e->where));
+  new_c->iterator = iterator;
+  new_expr->value.constructor = newbase;
+
+  id = fn->value.function.isym->id;
+
+  if (id == GFC_ISYM_SUM || id == GFC_ISYM_PRODUCT)
+    fcn = gfc_build_intrinsic_call (current_ns,
+				    fn->value.function.isym->id,
+				    fn->value.function.isym->name,
+				    fn->where, 3, new_expr,
+				    NULL, NULL);
+  else if (id == GFC_ISYM_ANY || id == GFC_ISYM_ALL)
+    fcn = gfc_build_intrinsic_call (current_ns,
+				    fn->value.function.isym->id,
+				    fn->value.function.isym->name,
+				    fn->where, 2, new_expr,
+				    NULL);
+  else
+    gfc_internal_error ("Illegal id in insert_iterator_function");
+
   return fcn;
 }
 
@@ -300,15 +339,19 @@  callback_reduction (gfc_expr **e, int *walk_subtre
 
   c = gfc_constructor_first (arg->value.constructor);
 
-  /* Don't do any simplififcation if we have
-     - no element in the constructor or
-     - only have a single element in the array which contains an
-     iterator.  */
+  /* Don't do any simplififcation if we have no element
+     in the constructor.  */
 
-  if (c == NULL || (c->iterator != NULL && gfc_constructor_next (c) == NULL))
+  if (c == NULL)
     return 0;
 
-  res = copy_walk_reduction_arg (c->expr, fn);
+  if (c->iterator)
+    {
+      res = insert_iterator_function (c->expr, fn, c->iterator);
+      c->iterator = NULL;
+    }
+  else
+    res = copy_walk_reduction_arg (c->expr, fn);
 
   c = gfc_constructor_next (c);
   while (c)
@@ -320,7 +363,15 @@  callback_reduction (gfc_expr **e, int *walk_subtre
       new_expr->where = fn->where;
       new_expr->value.op.op = op;
       new_expr->value.op.op1 = res;
-      new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+
+      if (c->iterator)
+	{
+	  new_expr->value.op.op2 = insert_iterator_function (c->expr, fn, c->iterator);
+	  c->iterator = NULL;
+	}
+      else
+	new_expr->value.op.op2 = copy_walk_reduction_arg (c->expr, fn);
+
       res = new_expr;
       c = gfc_constructor_next (c);
     }
Index: testsuite/gfortran.dg/array_constructor_40.f90
===================================================================
--- testsuite/gfortran.dg/array_constructor_40.f90	(Revision 197233)
+++ testsuite/gfortran.dg/array_constructor_40.f90	(Arbeitskopie)
@@ -48,5 +48,5 @@  program main
   call baz(a,b,res);
   if (abs(res - 8.1) > 1e-5) call abort
 end program main
-! { dg-final { scan-tree-dump-times "while" 3 "original" } }
+! { dg-final { scan-tree-dump-times "while" 5 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }