Re: PR fortran/19928: Scalarisation of substrings

[Richard Sandiford <richard at codesourcery dot com>]

Paul Brook <paul@codesourcery.com> writes:
>> gcc/fortran/
>> 	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.
>>
>> gcc/testsuite/
>> 	PR fortran/19928
>> 	* gfortran.fortran-torture/execute/pr19928-1.f90,
>> 	* gfortran.fortran-torture/execute/pr19928-2.f90: New tests.
>
> Ok.
> I'd appreciate a short comment in the testcase saying what they are
> testing. I realise this can be obtained from the PR, but it's nice to
> have it in the testcase itself. Something like
> /* PR19928: Check that the scalarizer pulls array index expression for 
> subobjects of an array section out of the loop */
> Is sufficient.
> Also, I think we prefer new testcases added in gfortran.dg/ as that test
> harness is more flexible.

OK, thanks, here's what I checked in.

Richard


gcc/fortran/
	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.

gcc/testsuite/
	PR fortran/19928
	* gfortran.dg/pr19928-1.f90, gfortran.dg/pr19928-2.f90: New tests.

Index: gcc/fortran/trans-array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-array.c,v
retrieving revision 1.55
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.55 trans-array.c
*** gcc/fortran/trans-array.c 27 Aug 2005 11:28:51 -0000 1.55
--- gcc/fortran/trans-array.c 8 Sep 2005 16:06:12 -0000
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 1660,1665 ****
--- 1660,1666 ----
    if (ar->type != AR_ELEMENT)
      {
        gfc_conv_scalarized_array_ref (se, ar);
+       gfc_advance_se_ss_chain (se);
        return;
      }
  
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 1671,1677 ****
    for (n = 0; n < ar->dimen; n++)
      {
        /* Calculate the index for this dimension.  */
!       gfc_init_se (&indexse, NULL);
        gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
        gfc_add_block_to_block (&se->pre, &indexse.pre);
  
--- 1672,1678 ----
    for (n = 0; n < ar->dimen; n++)
      {
        /* Calculate the index for this dimension.  */
!       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);
  
*************** gfc_walk_variable_expr (gfc_ss * ss, gfc
*** 4082,4089 ****
    int n;
  
    for (ref = expr->ref; ref; ref = ref->next)
      {
!       /* We're only interested in array sections.  */
        if (ref->type != REF_ARRAY)
  	continue;
  
--- 4083,4109 ----
    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)
      {
!       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;
  
*************** gfc_walk_variable_expr (gfc_ss * ss, gfc
*** 4091,4098 ****
        switch (ar->type)
  	{
  	case AR_ELEMENT:
!           /* TODO: Take elemental array references out of scalarization
!              loop.  */
  	  break;
  
  	case AR_FULL:
--- 4111,4124 ----
        switch (ar->type)
  	{
  	case AR_ELEMENT:
! 	  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:
*************** gfc_walk_variable_expr (gfc_ss * ss, gfc
*** 4115,4121 ****
  	      gcc_assert (ar->end[n] == NULL);
  	      gcc_assert (ar->stride[n] == NULL);
  	    }
! 	  return newss;
  
  	case AR_SECTION:
  	  newss = gfc_get_ss ();
--- 4141,4148 ----
  	      gcc_assert (ar->end[n] == NULL);
  	      gcc_assert (ar->stride[n] == NULL);
  	    }
! 	  ss = newss;
! 	  break;
  
  	case AR_SECTION:
  	  newss = gfc_get_ss ();
*************** gfc_walk_variable_expr (gfc_ss * ss, gfc
*** 4182,4188 ****
  	    }
  	  /* We should have at least one non-elemental dimension.  */
  	  gcc_assert (newss->data.info.dimen > 0);
! 	  return head;
  	  break;
  
  	default:
--- 4209,4215 ----
  	    }
  	  /* We should have at least one non-elemental dimension.  */
  	  gcc_assert (newss->data.info.dimen > 0);
! 	  ss = newss;
  	  break;
  
  	default:
Index: gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.58
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.58 trans-expr.c
*** gcc/fortran/trans-expr.c 8 Sep 2005 09:20:01 -0000 1.58
--- gcc/fortran/trans-expr.c 8 Sep 2005 16:06:12 -0000
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 305,311 ****
        /* 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;
      }
    else
      {
--- 305,313 ----
        /* A scalarized term.  We already know the descriptor.  */
        se->expr = se->ss->data.info.descriptor;
        se->string_length = se->ss->string_length;
!       for (ref = se->ss->data.info.ref; ref; ref = ref->next)
! 	if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
! 	  break;
      }
    else
      {
*************** gfc_conv_variable (gfc_se * se, gfc_expr
*** 444,451 ****
        else 
  	se->expr = gfc_build_addr_expr (NULL, se->expr);
      }
-   if (se->ss != NULL)
-     gfc_advance_se_ss_chain (se);
  }
  
  
--- 446,451 ----
Index: gcc/testsuite/gfortran.dg/pr19928-1.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/pr19928-1.f90
diff -N gcc/testsuite/gfortran.dg/pr19928-1.f90
*** gcc/testsuite/gfortran.dg/pr19928-1.f90 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/pr19928-1.f90 8 Sep 2005 16:06:12 -0000
***************
*** 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
Index: gcc/testsuite/gfortran.dg/pr19928-2.f90
===================================================================
RCS file: gcc/testsuite/gfortran.dg/pr19928-2.f90
diff -N gcc/testsuite/gfortran.dg/pr19928-2.f90
*** gcc/testsuite/gfortran.dg/pr19928-2.f90 1 Jan 1970 00:00:00 -0000
--- gcc/testsuite/gfortran.dg/pr19928-2.f90 8 Sep 2005 16:06:12 -0000
***************
*** 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