[Patch, fortran] PR35780 - internal compiler error for complicated PARAMETER expressions

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

:ADDPATCH fortran:

I dropped working on WHERE PRs to do this because it was originally
posted as a regression.  In fact I do not think that it was but I have
fixed it anyway:)

This is a simple extension of expr.c(scalarize_intrinsic_call) to use
any of the arguments of an elemental intrinsic function as the
template to build up the array of function calls.  When I wrote this
function, I had not thought through the possibility that multiple
argument elementals might need scalarization.  The patch speaks for
itself and the testcase is essentially the reporter's.

Bootstrapped and regtested on x86_ia64/FC8 - OK for trunk and 4.3?

Paul

2008-04-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35780
	* expr.c (scalarize_intrinsic_call): Identify which argument is
	an array and use that as the template.
	(check_init_expr): Remove tests that first argument is an array
	in the call to scalarize_intrinsic_call.

2008-04-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35780
	* gfortran.dg/simplify_argN_1.f90: New test.

Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c	(revision 133937)
--- gcc/fortran/expr.c	(working copy)
*************** scalarize_intrinsic_call (gfc_expr *e)
*** 1702,1718 ****
    gfc_actual_arglist *a, *b;
    gfc_constructor *args[5], *ctor, *new_ctor;
    gfc_expr *expr, *old;
!   int n, i, rank[5];
  
    old = gfc_copy_expr (e);
  
! /* Assume that the old expression carries the type information and
!    that the first arg carries all the shape information.  */
!   expr = gfc_copy_expr (old->value.function.actual->expr);
    gfc_free_constructor (expr->value.constructor);
    expr->value.constructor = NULL;
  
    expr->ts = old->ts;
    expr->expr_type = EXPR_ARRAY;
  
    /* Copy the array argument constructors into an array, with nulls
--- 1702,1735 ----
    gfc_actual_arglist *a, *b;
    gfc_constructor *args[5], *ctor, *new_ctor;
    gfc_expr *expr, *old;
!   int n, i, rank[5], array_arg;
  
    old = gfc_copy_expr (e);
  
! 
!   /* Find which, if any, arguments are arrays.  Assume that the old
!      expression carries the type information and that the first or
!      second arg carries all the shape information.*/
!   n = array_arg = 0;
!   a = old->value.function.actual;
!   for (; a; a = a->next)
!     {
!       n++;
!       if (a->expr->expr_type != EXPR_ARRAY)
! 	continue;
!       array_arg = n;
!       expr = gfc_copy_expr (a->expr);
!       break;
!     }
! 
!   if (!array_arg)
!     goto cleanup;
! 
    gfc_free_constructor (expr->value.constructor);
    expr->value.constructor = NULL;
  
    expr->ts = old->ts;
+   expr->where = old->where;
    expr->expr_type = EXPR_ARRAY;
  
    /* Copy the array argument constructors into an array, with nulls
*************** scalarize_intrinsic_call (gfc_expr *e)
*** 1745,1758 ****
        n++;
      }
  
-   for (i = 1; i < n; i++)
-     if (rank[i] && rank[i] != rank[0])
-       goto compliance;
  
    /* Using the first argument as the master, step through the array
       calling the function for each element and advancing the array
       constructors together.  */
!   ctor = args[0];
    new_ctor = NULL;
    for (; ctor; ctor = ctor->next)
      {
--- 1762,1772 ----
        n++;
      }
  
  
    /* Using the first argument as the master, step through the array
       calling the function for each element and advancing the array
       constructors together.  */
!   ctor = args[array_arg - 1];
    new_ctor = NULL;
    for (; ctor; ctor = ctor->next)
      {
*************** scalarize_intrinsic_call (gfc_expr *e)
*** 1786,1802 ****
  	      b = b->next;
  	    }
  
! 	  /* Simplify the function calls.  */
! 	  if (gfc_simplify_expr (new_ctor->expr, 0) == FAILURE)
! 	    goto cleanup;
  
  	  for (i = 0; i < n; i++)
  	    if (args[i])
  	      args[i] = args[i]->next;
  
  	  for (i = 1; i < n; i++)
! 	    if (rank[i] && ((args[i] != NULL && args[0] == NULL)
! 			 || (args[i] == NULL && args[0] != NULL)))
  	      goto compliance;
      }
  
--- 1800,1817 ----
  	      b = b->next;
  	    }
  
! 	  /* Simplify the function calls.  If the simplification fails, the
! 	     error will be flagged up down-stream or the library will deal
! 	     with it.  */
! 	  gfc_simplify_expr (new_ctor->expr, 0);
  
  	  for (i = 0; i < n; i++)
  	    if (args[i])
  	      args[i] = args[i]->next;
  
  	  for (i = 1; i < n; i++)
! 	    if (rank[i] && ((args[i] != NULL && args[array_arg - 1] == NULL)
! 			 || (args[i] == NULL && args[array_arg - 1] != NULL)))
  	      goto compliance;
      }
  
*************** check_init_expr (gfc_expr *e)
*** 2187,2197 ****
  	     array argument.  */
  	  isym = gfc_find_function (e->symtree->n.sym->name);
  	  if (isym && isym->elemental
! 	      && e->value.function.actual->expr->expr_type == EXPR_ARRAY)
! 	    {
! 		if ((t = scalarize_intrinsic_call (e)) == SUCCESS)
! 		break;
! 	    }
  	}
  
        if (m == MATCH_YES)
--- 2202,2209 ----
  	     array argument.  */
  	  isym = gfc_find_function (e->symtree->n.sym->name);
  	  if (isym && isym->elemental
! 		&& (t = scalarize_intrinsic_call (e)) == SUCCESS)
! 	    break;
  	}
  
        if (m == MATCH_YES)
Index: gcc/testsuite/gfortran.dg/simplify_argN_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/simplify_argN_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/simplify_argN_1.f90	(revision 0)
***************
*** 0 ****
--- 1,26 ----
+ ! { dg-do run }
+ ! Tests the fix for PR35780, in which the assignment for C was not
+ ! scalarized in expr.c.
+ !
+ ! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+ !
+ MODULE MODS
+   integer, parameter :: N = 10
+   INTEGER, PARAMETER, DIMENSION(N) ::  A = [(i, i = 1, N)]
+   INTEGER, PARAMETER, DIMENSION(N) ::  B = [(i - 5, i = 1, N)]
+   INTEGER, PARAMETER, DIMENSION(N)  :: C = ISHFTC(3, B, 5)   !ICE
+   INTEGER, PARAMETER, DIMENSION(N)  :: D = ISHFTC(A, 3, 5)   !  OK
+   INTEGER, PARAMETER, DIMENSION(N)  :: E = ISHFTC(A, B, 5)   !  OK
+ 
+ END MODULE MODS
+ 
+   use mods
+   integer, dimension(N) :: X = A
+   integer, dimension(N) :: Y = B
+ 
+ ! Check the simplifed expressions against the library
+   if (any (ISHFTC(3, Y, 5) /= C)) call abort ()
+   if (any (ISHFTC(X, 3, 5) /= D)) call abort ()
+   if (any (ISHFTC(X, Y, 5) /= E)) call abort ()
+ end
+ ! { dg-final { cleanup-modules "mods" } }

Property changes on: gcc/testsuite/gfortran.dg/simplify_argN_1.f90
___________________________________________________________________
Name: svn:executable
   + *