re PR fortran/19928 (Reference of constant derived type component causes failure)

	PR fortran/19928
	* trans-array.c (gfc_conv_array_ref): Call gfc_advance_se_ss_chain
	after handling scalarized references.  Make "indexse" inherit from
	"se" when handling AR_ELEMENTs.
	(gfc_walk_variable_expr): Add GFC_SS_SCALAR entries for each
	substring or scalar reference that follows an array section.
	* trans-expr.c (gfc_conv_variable): When called from within a
	scalarization loop, start out with "ref" pointing to the scalarized
	part of the reference.  Don't call gfc_advance_se_ss_chain here.

From-SVN: r104035

gcc/fortran/ChangeLog

+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/19928
+	* trans-array.c (gfc_conv_array_ref): Call gfc_advance_se_ss_chain
+	after handling scalarized references.  Make "indexse" inherit from
+	"se" when handling AR_ELEMENTs.
+	(gfc_walk_variable_expr): Add GFC_SS_SCALAR entries for each
+	substring or scalar reference that follows an array section.
+	* trans-expr.c (gfc_conv_variable): When called from within a
+	scalarization loop, start out with "ref" pointing to the scalarized
+	part of the reference.  Don't call gfc_advance_se_ss_chain here.
+
 2005-09-07  Richard Sandiford  <richard@codesourcery.com>
 
 	PR fortran/23373

gcc/fortran/trans-array.c

@@ -1660,6 +1660,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
   if (ar->type != AR_ELEMENT)
     {
       gfc_conv_scalarized_array_ref (se, ar);
+      gfc_advance_se_ss_chain (se);
       return;
     }
 
@@ -1671,7 +1672,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
   for (n = 0; n < ar->dimen; n++)
     {
       /* Calculate the index for this dimension.  */
-      gfc_init_se (&indexse, NULL);
+      gfc_init_se (&indexse, se);
       gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
       gfc_add_block_to_block (&se->pre, &indexse.pre);
 
@@ -4082,8 +4083,27 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
   int n;
 
   for (ref = expr->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+      break;
+
+  for (; ref; ref = ref->next)
     {
-      /* We're only interested in array sections.  */
+      if (ref->type == REF_SUBSTRING)
+	{
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SCALAR;
+	  newss->expr = ref->u.ss.start;
+	  newss->next = ss;
+	  ss = newss;
+
+	  newss = gfc_get_ss ();
+	  newss->type = GFC_SS_SCALAR;
+	  newss->expr = ref->u.ss.end;
+	  newss->next = ss;
+	  ss = newss;
+	}
+
+      /* We're only interested in array sections from now on.  */
       if (ref->type != REF_ARRAY)
 	continue;
 
@@ -4091,8 +4111,14 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
       switch (ar->type)
 	{
 	case AR_ELEMENT:
-          /* TODO: Take elemental array references out of scalarization
-             loop.  */
+	  for (n = 0; n < ar->dimen; n++)
+	    {
+	      newss = gfc_get_ss ();
+	      newss->type = GFC_SS_SCALAR;
+	      newss->expr = ar->start[n];
+	      newss->next = ss;
+	      ss = newss;
+	    }
 	  break;
 
 	case AR_FULL:
@@ -4115,7 +4141,8 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
 	      gcc_assert (ar->end[n] == NULL);
 	      gcc_assert (ar->stride[n] == NULL);
 	    }
-	  return newss;
+	  ss = newss;
+	  break;
 
 	case AR_SECTION:
 	  newss = gfc_get_ss ();
@@ -4182,7 +4209,7 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
 	    }
 	  /* We should have at least one non-elemental dimension.  */
 	  gcc_assert (newss->data.info.dimen > 0);
-	  return head;
+	  ss = newss;
 	  break;
 
 	default:

gcc/fortran/trans-expr.c

@@ -305,7 +305,9 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
       /* A scalarized term.  We already know the descriptor.  */
       se->expr = se->ss->data.info.descriptor;
       se->string_length = se->ss->string_length;
-      ref = se->ss->data.info.ref;
+      for (ref = se->ss->data.info.ref; ref; ref = ref->next)
+	if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
+	  break;
     }
   else
     {
@@ -444,8 +446,6 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
       else 
 	se->expr = gfc_build_addr_expr (NULL, se->expr);
     }
-  if (se->ss != NULL)
-    gfc_advance_se_ss_chain (se);
 }
 
 

gcc/testsuite/ChangeLog

+2005-09-08  Richard Sandiford  <richard@codesourcery.com>
+
+	PR fortran/19928
+	* gfortran.dg/pr19928-1.f90, gfortran.dg/pr19928-2.f90: New tests.
+
 2005-09-08  Andrew Pinski  <pinskia@physics.uc.edu>
 
 	PR obj-c++/16816

gcc/testsuite/gfortran.dg/pr19928-1.f90

+! PR 19928.  Check the use of constant substring indexes in a
+! scalarization loop.
+! { dg-do run }
+program main
+  implicit none
+  character (len = 5), dimension (2) :: a
+  character (len = 3), dimension (2) :: b
+  a = (/ 'abcde', 'ghijk' /)
+  b = a(:)(2:4)
+  if (b(1) .ne. 'bcd' .or. b(2) .ne. 'hij') call abort
+end program main

gcc/testsuite/gfortran.dg/pr19928-2.f90

+! Related to PR 19928.  Check that foo() is only called once per statement.
+! { dg-do run }
+program main
+  implicit none
+  type t
+    integer, dimension (5) :: field
+  end type t
+  type (t), dimension (2) :: a
+  integer :: calls, i, j
+
+  forall (i = 1:2, j = 1:5) a(i)%field(j) = i * 100 + j
+  calls = 0
+  if (sum (a%field(foo(calls))) .ne. 304) call abort
+  if (calls .ne. 1) call abort
+  if (sum (a(foo(calls))%field) .ne. 1015) call abort
+  if (calls .ne. 2) call abort
+contains
+  function foo (calls)
+    integer :: calls, foo
+    calls = calls + 1
+    foo = 2
+  end function foo 
+end program main