PR fortran/19928: Scalarisation of substrings
Richard Sandiford
richard@codesourcery.com
Sat Aug 27 11:30:00 GMT 2005
This patch fixes an ICE on:
character :: signal_names(10)*16
write (*,*) signal_names(:)(1:4)
It also fixes the related problem that:
array(:)%field(foo())
will call foo() in every iteration of the scalarisation loop.
(Thanks to Paul B. for pointing out the connection.)
For the first testcase, gfc_conv_substring tries to convert "1" and "4"
like so:
gfc_init_se (&start, se);
gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
...
gfc_init_se (&end, se);
gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
Thus "start" and "end" inherit "se"'s scalarisation state, and we
call gfc_conv_constant with se->ss != NULL. gfc_conv_constant then
expects the next part of the scalarisation chain to be a GFC_SS_SCALAR:
if (se->ss != NULL)
{
gcc_assert (se->ss != gfc_ss_terminator);
gcc_assert (se->ss->type == GFC_SS_SCALAR);
gcc_assert (se->ss->expr == expr);
se->expr = se->ss->data.scalar.expr;
se->string_length = se->ss->string_length;
gfc_advance_se_ss_chain (se);
return;
}
It isn't though. The only ss element created for "signal_names(:)(1:4)"
is the GFC_SS_SECTION for "signal_names(:)".
The problem for "array(:)%field(foo())" is similar. We have a
GFC_SS_SECTION for "array(:)", but no GFC_SS_SCALAR for "foo()",
so "foo()" is re-evaluated by every iteration.
The patch fixes this by adding a GFC_SS_SCALAR for each substring
or scalar index that follows an array section. Specifically,
gfc_walk_variable will look for the array section reference:
for (ref = expr->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->u.ar.type != AR_ELEMENT)
break;
and then add appropriate ss elements for "ref" and for every
reference that follows it.
This requires two follow-on changes:
- After converting an array section, gfc_conv_array_ref needs to
advance past the GFC_SS_SECTION using gfc_advance_se_ss_chain.
This allows subsequent scalar and substring references to use
their associated GFC_SS_SCALAR entries.
This new call to gfc_advance_se_ss_chain replaces the one at
the end of gfc_conv_variable.
- gfc_conv_index_expr needs to use the ss chain when evaluating
each index. Thus:
gfc_init_se (&indexse, NULL);
becomes:
gfc_init_se (&indexse, se);
- When handling scalarised references, gfc_conv_variable needs to
search for the section reference using the same loop as the
gfc_walk_variable one quoted above.
The code might (or might not!) work without this change, but either
way, it seems more theoretically correct. Any references before the
array section will have been evaluated outside of the scalarisation
loop, in order to obtain the cached descriptor. For example, if we
have "array(1)%field(:)", we'll have evaluated "array(1)" outside
the loop and don't need to evaluate "1" again.
Bootstrapped & regression tested on i686-pc-linux-gnu. OK to install?
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.fortran-torture/execute/pr19928-1.f90,
* gfortran.fortran-torture/execute/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.54
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.54 trans-array.c
*** gcc/fortran/trans-array.c 6 Aug 2005 12:56:18 -0000 1.54
--- gcc/fortran/trans-array.c 26 Aug 2005 15:32:49 -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.57
diff -c -p -F^\([(a-zA-Z0-9_]\|#define\) -r1.57 trans-expr.c
*** gcc/fortran/trans-expr.c 16 Aug 2005 12:58:46 -0000 1.57
--- gcc/fortran/trans-expr.c 26 Aug 2005 15:32:50 -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 ----
diff -c /dev/null gcc/testsuite/gfortran.fortran-torture/execute/pr19928-1.f90
*** /dev/null 2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.fortran-torture/execute/pr19928-1.f90 2005-08-26 16:29:33.000000000 +0100
***************
*** 0 ****
--- 1,8 ----
+ 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 -c /dev/null gcc/testsuite/gfortran.fortran-torture/execute/pr19928-2.f90
*** /dev/null 2005-06-16 22:49:09.000000000 +0100
--- gcc/testsuite/gfortran.fortran-torture/execute/pr19928-2.f90 2005-08-26 16:31:48.000000000 +0100
***************
*** 0 ****
--- 1,21 ----
+ 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
More information about the Fortran
mailing list