[patch, Fortran] Fix PR 60834

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

this contains a straightforward fix for the regression by
not trying to do combine array constructors inside
association lists.

Regression-tested.  OK for all affected open branches?

	Thomas

2014-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/60834
        * frontend-passes.c (in_assoc_list):  New variable.
        (optimize_namespace):  Initialize in_assoc_list
        (combine_array_constructor): Don't try to combine
        assoc lists.
        (gfc_code_walker):  Keep track of in_assoc_list.

2014-05-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/60834
        * gfortran.dg/associate_16.f90:  New test.

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 209333)
+++ frontend-passes.c	(Arbeitskopie)
@@ -88,6 +88,10 @@ static int doloop_size, doloop_level;
 
 struct my_struct *evec;
 
+/* Keep track of association lists.  */
+
+static bool in_assoc_list;
+
 /* Entry point - run all passes for a namespace. */
 
 void
@@ -820,6 +824,7 @@ optimize_namespace (gfc_namespace *ns)
   current_ns = ns;
   forall_level = 0;
   iterator_level = 0;
+  in_assoc_list = false;
   in_omp_workshare = false;
 
   gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
@@ -1054,6 +1059,11 @@ combine_array_constructor (gfc_expr *e)
   if (e->rank != 1)
     return false;
 
+  /* Don't try to combine association lists, this makes no sense
+     and leads to an ICE.  */
+  if (in_assoc_list)
+    return false;
+
   op1 = e->value.op.op1;
   op2 = e->value.op.op2;
 
@@ -1940,8 +1950,17 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
 
 	    case EXEC_BLOCK:
 	      WALK_SUBCODE (co->ext.block.ns->code);
-	      for (alist = co->ext.block.assoc; alist; alist = alist->next)
-		WALK_SUBEXPR (alist->target);
+	      if (co->ext.block.assoc)
+		{
+		  bool saved_in_assoc_list = in_assoc_list;
+
+		  in_assoc_list = true;
+		  for (alist = co->ext.block.assoc; alist; alist = alist->next)
+		    WALK_SUBEXPR (alist->target);
+
+		  in_assoc_list = saved_in_assoc_list;
+		}
+
 	      break;
 
 	    case EXEC_DO:

! { dg-do compile }
! PR 60834 - this used to ICE.

module m
  implicit none
  type :: t
    real :: diffusion=1.
  end type
contains
  subroutine solve(this, x)
    class(t), intent(in) :: this
    real, intent(in) :: x(:)
    integer :: i
    integer, parameter :: n(1:5)=[(i,i=1, 5)]

    associate( nu=>this%diffusion)
      associate( exponential=>exp(-(x(i)-n) ))
        do i = 1, size(x)
        end do
      end associate
    end associate
  end subroutine solve
end module m