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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104035 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e2afd7c..e8e64ad 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 3e7b869..9012a07 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/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:

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 0d3cb69..b20ed13 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/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);
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 716cd8f..f20a576 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/pr19928-1.f90 b/gcc/testsuite/gfortran.dg/pr19928-1.f90
new file mode 100644 (file)
index 0000000..a8b04d8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19928-1.f90
@@ -0,0 +1,11 @@
+! 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

diff --git a/gcc/testsuite/gfortran.dg/pr19928-2.f90 b/gcc/testsuite/gfortran.dg/pr19928-2.f90
new file mode 100644 (file)
index 0000000..6bfdd0f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr19928-2.f90
@@ -0,0 +1,23 @@
+! 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