This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] PR28174 - actual args with substring refs and PR28167 - character array constructors
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: patch <gcc-patches at gcc dot gnu dot org>, "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, Harald Anlauf <anlauf at gmx dot de>
- Date: Fri, 30 Jun 2006 00:03:10 +0200
- Subject: [Patch, fortran] PR28174 - actual args with substring refs and PR28167 - character array constructors
I have to confess that the only common features between these PRs is
that character actual arguments are involved and that the reporter is
the same. Harald, what are you trying to do to me?
They were developed in parallel, came ready together and so are
submitted as a package. If anything, I would give priority to PR28174.
However, both add considerable functionality to gfortran.
:ADDPATCH fortran:
The first emerged from my fix to PR28118, for character array actual
arguments with substring references. I did not do enough testing to
find out that by not creating a new gfc_charlen and writing the
substring length to the original, I screwed up the source array and
anything to which it had been equated! This was easily fixed by
allocating a new gfc_charlen, linking it into the chain and passing it
the substring length.
Whilst doing this, I noticed that the patch was not capable of passing
back the dummy values to the actual; that is, it was only capable of
intent(in). Thus, leaving the repair in array.c, I effected the same to
the fix for component actuals of structure arrays and allowed it to
handle substring array references. At the same time, I corrected it to
make sure that it would do the right thing with the various intents.
PR28167 was an apparent translation problem that turns out to be due to
missing front-end features. This would ICE:
call foo ((/('a', i = 1, 2)/))
end
The problem was fixed by ensuring that
array.c(resolve_character_array_constructor) used any gfc_charlens that
applied to the constructor elements for the expression itself. Have
both around caused the ICE because one did not have a length attached to
it. After I did this, I noticed that
call foo ((/(achar(64+i), i = 1, 2)/))
end
and
call foo ((/(a(i)(2:3), i = 1, 2)/))
end
still ICEd in the same place. It turned out that the reason is the same
- the frontend was just not getting a character length to the
expression. For the former, the constructor part of gfc_resolve_expr,
needed to revisit resolve_character_array_constructor to ensure that the
length information was attached to the simplified function result. In
the case of the latter, resolve_character_array_constructor was simply
not doing constant substring references for variables. This was added
and the receiving end added in
trans-array.c(get_array_ctor_var_strlen). It should be noted that
variable substring references are yet to come.... sometime!
The test cases are straightforward exercises of the above fixes.
Regtested on FC5/Athlon1700 - OK for trunk and 4.1?
Paul
2006-06-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28174
* trans-array.c (gfc_conv_expr_descriptor): When building temp,
ensure that the substring reference uses a new charlen.
* trans-expr.c (gfc_conv_aliased_arg): Add the formal intent to
the argument list, lift the treatment of missing string lengths
from the above and implement the use of the intent.
(gfc_conv_function_call): Add the extra argument to the call to
the above.
PR fortran/28167
* trans-array.c (get_array_ctor_var_strlen): Treat a constant
substring reference.
* array.c (resolve_character_array_constructor): Remove static
attribute, make use of element charlens for the expression and
pick up constant string lengths for expressions that are not
themselves constant.
* gfortran.h : resolve_character_array_constructor prototype
added.
* resolve.c (gfc_resolve_expr): Call resolve_character_array_
constructor again after expanding the constructor, to ensure
that the character length is passed to the expression.
2006-06-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28174
* gfortran.dg/actual_array_substr_2.f90: New test.
PR fortran/28167
* gfortran.dg/actual_array_constructor_2.f90: New test.
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 114986)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_apply_interface_mapping (gfc_interfa
*** 1591,1597 ****
handling aliased arrays. */
static void
! gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr, int g77)
{
gfc_se lse;
gfc_se rse;
--- 1591,1598 ----
handling aliased arrays. */
static void
! gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
! int g77, sym_intent intent)
{
gfc_se lse;
gfc_se rse;
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1635,1641 ****
loop.temp_ss->data.temp.type = base_type;
if (expr->ts.type == BT_CHARACTER)
! loop.temp_ss->string_length = expr->ts.cl->backend_decl;
loop.temp_ss->data.temp.dimen = loop.dimen;
loop.temp_ss->next = gfc_ss_terminator;
--- 1636,1672 ----
loop.temp_ss->data.temp.type = base_type;
if (expr->ts.type == BT_CHARACTER)
! {
! gfc_ref *char_ref = expr->ref;
!
! for (; expr->ts.cl == NULL && char_ref; char_ref = char_ref->next)
! if (char_ref->type == REF_SUBSTRING)
! {
! gfc_se tmp_se;
!
! expr->ts.cl = gfc_get_charlen ();
! expr->ts.cl->next = char_ref->u.ss.length->next;
! char_ref->u.ss.length->next = expr->ts.cl;
!
! gfc_init_se (&tmp_se, NULL);
! gfc_conv_expr_type (&tmp_se, char_ref->u.ss.end,
! gfc_array_index_type);
! tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
! tmp_se.expr, gfc_index_one_node);
! tmp = gfc_evaluate_now (tmp, &parmse->pre);
! gfc_init_se (&tmp_se, NULL);
! gfc_conv_expr_type (&tmp_se, char_ref->u.ss.start,
! gfc_array_index_type);
! tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
! tmp, tmp_se.expr);
! expr->ts.cl->backend_decl = tmp;
!
! break;
! }
! loop.temp_ss->data.temp.type
! = gfc_typenode_for_spec (&expr->ts);
! loop.temp_ss->string_length = expr->ts.cl->backend_decl;
! }
loop.temp_ss->data.temp.dimen = loop.dimen;
loop.temp_ss->next = gfc_ss_terminator;
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1668,1679 ****
gfc_conv_tmp_array_ref (&lse);
gfc_advance_se_ss_chain (&lse);
! tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type);
! gfc_add_expr_to_block (&body, tmp);
!
! gcc_assert (rse.ss == gfc_ss_terminator);
!
! gfc_trans_scalarizing_loops (&loop, &body);
/* Add the post block after the second loop, so that any
freeing of allocated memory is done at the right time. */
--- 1699,1711 ----
gfc_conv_tmp_array_ref (&lse);
gfc_advance_se_ss_chain (&lse);
! if (intent != INTENT_OUT)
! {
! tmp = gfc_trans_scalar_assign (&lse, &rse, expr->ts.type);
! gfc_add_expr_to_block (&body, tmp);
! gcc_assert (rse.ss == gfc_ss_terminator);
! gfc_trans_scalarizing_loops (&loop, &body);
! }
/* Add the post block after the second loop, so that any
freeing of allocated memory is done at the right time. */
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1761,1770 ****
gfc_trans_scalarizing_loops (&loop2, &body);
/* Wrap the whole thing up by adding the second loop to the post-block
! and following it by the post-block of the fist loop. In this way,
if the temporary needs freeing, it is done after use! */
! gfc_add_block_to_block (&parmse->post, &loop2.pre);
! gfc_add_block_to_block (&parmse->post, &loop2.post);
gfc_add_block_to_block (&parmse->post, &loop.post);
--- 1793,1805 ----
gfc_trans_scalarizing_loops (&loop2, &body);
/* Wrap the whole thing up by adding the second loop to the post-block
! and following it by the post-block of the first loop. In this way,
if the temporary needs freeing, it is done after use! */
! if (intent != INTENT_IN)
! {
! gfc_add_block_to_block (&parmse->post, &loop2.pre);
! gfc_add_block_to_block (&parmse->post, &loop2.post);
! }
gfc_add_block_to_block (&parmse->post, &loop.post);
*************** is_aliased_array (gfc_expr * e)
*** 1799,1805 ****
if (ref->type == REF_ARRAY)
seen_array = true;
! if (ref->next == NULL && ref->type == REF_COMPONENT)
return seen_array;
}
return false;
--- 1834,1841 ----
if (ref->type == REF_ARRAY)
seen_array = true;
! if (ref->next == NULL
! && ref->type != REF_ARRAY)
return seen_array;
}
return false;
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 1937,1949 ****
&& !(fsym->attr.pointer || fsym->attr.allocatable)
&& fsym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
if (e->expr_type == EXPR_VARIABLE
&& is_aliased_array (e))
/* The actual argument is a component reference to an
array of derived types. In this case, the argument
is converted to a temporary, which is passed and then
written back after the procedure call. */
! gfc_conv_aliased_arg (&parmse, e, f);
else
gfc_conv_array_parameter (&parmse, e, argss, f);
--- 1973,1986 ----
&& !(fsym->attr.pointer || fsym->attr.allocatable)
&& fsym->as->type != AS_ASSUMED_SHAPE;
f = f || !sym->attr.always_explicit;
+
if (e->expr_type == EXPR_VARIABLE
&& is_aliased_array (e))
/* The actual argument is a component reference to an
array of derived types. In this case, the argument
is converted to a temporary, which is passed and then
written back after the procedure call. */
! gfc_conv_aliased_arg (&parmse, e, f, fsym->attr.intent);
else
gfc_conv_array_parameter (&parmse, e, argss, f);
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 114986)
--- gcc/fortran/trans-array.c (working copy)
*************** get_array_ctor_var_strlen (gfc_expr * ex
*** 1341,1346 ****
--- 1341,1347 ----
{
gfc_ref *ref;
gfc_typespec *ts;
+ mpz_t char_len;
/* Don't bother if we already know the length is a constant. */
if (*len && INTEGER_CST_P (*len))
*************** get_array_ctor_var_strlen (gfc_expr * ex
*** 1360,1365 ****
--- 1361,1379 ----
ts = &ref->u.c.component->ts;
break;
+ case REF_SUBSTRING:
+ if (ref->u.ss.start->expr_type != EXPR_CONSTANT
+ || ref->u.ss.start->expr_type != EXPR_CONSTANT)
+ break;
+ mpz_init_set_ui (char_len, 1);
+ mpz_add (char_len, char_len, ref->u.ss.end->value.integer);
+ mpz_sub (char_len, char_len, ref->u.ss.start->value.integer);
+ *len = gfc_conv_mpz_to_tree (char_len,
+ gfc_default_character_kind);
+ *len = convert (gfc_charlen_type_node, *len);
+ mpz_clear (char_len);
+ return;
+
default:
/* TODO: Substrings are tricky because we can't evaluate the
expression more than once. For now we just give up, and hope
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4192,4198 ****
if (char_ref->type == REF_SUBSTRING)
{
mpz_t char_len;
! expr->ts.cl = char_ref->u.ss.length;
mpz_init_set_ui (char_len, 1);
mpz_add (char_len, char_len,
char_ref->u.ss.end->value.integer);
--- 4206,4215 ----
if (char_ref->type == REF_SUBSTRING)
{
mpz_t char_len;
! expr->ts.cl = gfc_get_charlen ();
! expr->ts.cl->next = char_ref->u.ss.length->next;
! char_ref->u.ss.length->next = expr->ts.cl;
!
mpz_init_set_ui (char_len, 1);
mpz_add (char_len, char_len,
char_ref->u.ss.end->value.integer);
Index: gcc/fortran/array.c
===================================================================
*** gcc/fortran/array.c (revision 114986)
--- gcc/fortran/array.c (working copy)
*************** resolve_array_list (gfc_constructor * p)
*** 1518,1524 ****
not specified character length, update character length to the maximum of
its element constructors' length. */
! static void
resolve_character_array_constructor (gfc_expr * expr)
{
gfc_constructor * p;
--- 1518,1524 ----
not specified character length, update character length to the maximum of
its element constructors' length. */
! void
resolve_character_array_constructor (gfc_expr * expr)
{
gfc_constructor * p;
*************** resolve_character_array_constructor (gfc
*** 1531,1550 ****
if (expr->ts.cl == NULL)
{
expr->ts.cl = gfc_get_charlen ();
expr->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = expr->ts.cl;
}
if (expr->ts.cl->length == NULL)
{
/* Find the maximum length of the elements. Do nothing for variable array
! constructor. */
for (p = expr->value.constructor; p; p = p->next)
! if (p->expr->expr_type == EXPR_CONSTANT)
! max_length = MAX (p->expr->value.character.length, max_length);
! else
! return;
if (max_length != -1)
{
--- 1531,1583 ----
if (expr->ts.cl == NULL)
{
+ for (p = expr->value.constructor; p; p = p->next)
+ if (p->expr->ts.cl != NULL)
+ {
+ /* Ensure that if there is a char_len around that it is
+ used; otherwise the middle-end confuses them! */
+ expr->ts.cl = p->expr->ts.cl;
+ goto got_charlen;
+ }
+
expr->ts.cl = gfc_get_charlen ();
expr->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = expr->ts.cl;
}
+ got_charlen:
+
if (expr->ts.cl->length == NULL)
{
/* Find the maximum length of the elements. Do nothing for variable array
! constructor, unless the character length is constant or there is a
! constant substring reference. */
!
for (p = expr->value.constructor; p; p = p->next)
! {
! gfc_ref *ref;
! for (ref = p->expr->ref; ref; ref = ref->next)
! if (ref->type == REF_SUBSTRING
! && ref->u.ss.start->expr_type == EXPR_CONSTANT
! && ref->u.ss.end->expr_type == EXPR_CONSTANT)
! break;
!
! if (p->expr->expr_type == EXPR_CONSTANT)
! max_length = MAX (p->expr->value.character.length, max_length);
!
! else if (ref)
! max_length = MAX ((int)(mpz_get_ui (ref->u.ss.end->value.integer)
! - mpz_get_ui (ref->u.ss.start->value.integer))
! + 1, max_length);
!
! else if (p->expr->ts.cl && p->expr->ts.cl->length
! && p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
! max_length = MAX ((int)mpz_get_si (p->expr->ts.cl->length->value.integer),
! max_length);
!
! else
! return;
! }
if (max_length != -1)
{
*************** resolve_character_array_constructor (gfc
*** 1552,1558 ****
expr->ts.cl->length = gfc_int_expr (max_length);
/* Update the element constructors. */
for (p = expr->value.constructor; p; p = p->next)
! gfc_set_constant_character_len (max_length, p->expr);
}
}
}
--- 1585,1592 ----
expr->ts.cl->length = gfc_int_expr (max_length);
/* Update the element constructors. */
for (p = expr->value.constructor; p; p = p->next)
! if (p->expr->expr_type == EXPR_CONSTANT)
! gfc_set_constant_character_len (max_length, p->expr);
}
}
}
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 114986)
--- gcc/fortran/gfortran.h (working copy)
*************** void gfc_simplify_iterator_var (gfc_expr
*** 2028,2033 ****
--- 2028,2034 ----
try gfc_expand_constructor (gfc_expr *);
int gfc_constant_ac (gfc_expr *);
int gfc_expanded_ac (gfc_expr *);
+ void resolve_character_array_constructor (gfc_expr *);
try gfc_resolve_array_constructor (gfc_expr *);
try gfc_check_constructor_type (gfc_expr *);
try gfc_check_iter_variable (gfc_expr *);
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 114987)
--- gcc/fortran/resolve.c (working copy)
*************** gfc_resolve_expr (gfc_expr * e)
*** 2942,2947 ****
--- 2942,2952 ----
gfc_expand_constructor (e);
}
+ /* This provides the opportunity for the length of constructors with character
+ valued function elements to propogate the string length to the expression. */
+ if (e->ts.type == BT_CHARACTER)
+ resolve_character_array_constructor (e);
+
break;
case EXPR_STRUCTURE:
Index: gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/actual_array_constructor_2.f90 (revision 0)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ ! Tests the fix for pr28167, in which character array constructors
+ ! with an implied do loop would cause an ICE, when used as actual
+ ! arguments.
+ !
+ ! Based on the testscase by Harald Anlauf <anlauf@gmx.de>
+ !
+ character(4), dimension(4) :: c1, c2
+ integer m
+ m = 4
+ ! Test the original problem
+ call foo ((/( 'abcd',i=1,m )/), c2)
+ if (any(c2(:) .ne. (/'abcd','abcd', &
+ 'abcd','abcd'/))) call abort ()
+
+ ! Now get a bit smarter
+ call foo ((/"abcd", "efgh", "ijkl", "mnop"/), c1) ! worked previously
+ call foo ((/(c1(i), i = m,1,-1)/), c2) ! was broken
+ if (any(c2(4:1:-1) .ne. c1)) call abort ()
+
+ ! gfc_todo: Not Implemented: complex character array constructors
+ call foo ((/(c1(i)(i/2+1:i/2+2), i = 1,4)/), c2) ! Ha! take that..!
+ if (any (c2 .ne. (/"ab ","fg ","jk ","op "/))) call abort ()
+
+ ! Check functions in the constructor
+ call foo ((/(achar(64+i)//achar(68+i)//achar(72+i)// &
+ achar(76+i),i=1,4 )/), c1) ! was broken
+ if (any (c1 .ne. (/"AEIM","BFJN","CGKO","DHLP"/))) call abort ()
+ contains
+ subroutine foo (chr1, chr2)
+ character(*), dimension(:) :: chr1, chr2
+ chr2 = chr1
+ end subroutine foo
+ end
\ No newline at end of file
Index: gcc/testsuite/gfortran.dg/actual_array_substr_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/actual_array_substr_2.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/actual_array_substr_2.f90 (revision 0)
***************
*** 0 ****
--- 1,42 ----
+ ! { dg-do run }
+ ! Tests the fix for pr28174, in which the fix for pr28118 was
+ ! corrupting the character lengths of arrays that shared a
+ ! character length structure. In addition, in developing the
+ ! fix, it was noted that intent(out/inout) arguments were not
+ ! getting written back to the calling scope.
+ !
+ ! Based on the testscase by Harald Anlauf <anlauf@gmx.de>
+ !
+ program pr28174
+ implicit none
+ character(len=12) :: teststring(2) = (/ "abc def ghij", &
+ "klm nop qrst" /)
+ character(len=12) :: a(2), b(2), c(2), d(2)
+ integer :: m = 7, n
+ a = teststring
+ b = a
+ c = a
+ d = a
+ n = m - 4
+
+ ! Make sure that variable substring references work.
+ call foo (a(:)(m:m+5), c(:)(n:m+2), d(:)(5:9))
+ if (any (a .ne. teststring)) call abort ()
+ if (any (b .ne. teststring)) call abort ()
+ if (any (c .ne. (/"ab456789#hij", &
+ "kl7654321rst"/))) call abort ()
+ if (any (d .ne. (/"abc 23456hij", &
+ "klm 98765rst"/))) call abort ()
+ contains
+ subroutine foo (w, x, y)
+ character(len=*), intent(in) :: w(:)
+ character(len=*), intent(inOUT) :: x(:)
+ character(len=*), intent(OUT) :: y(:)
+ character(len=12) :: foostring(2) = (/"0123456789#$" , &
+ "$#9876543210"/)
+ if (all (x(:)(3:7) .eq. y)) call abort ()
+ x = foostring (:)(5 : 4 + len (x))
+ y = foostring (:)(3 : 2 + len (y))
+ end subroutine foo
+ end program pr28174
+
2006-06-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28174
* trans-array.c (gfc_conv_expr_descriptor): When building temp,
ensure that the substring reference uses a new charlen.
* trans-expr.c (gfc_conv_aliased_arg): Add the formal intent to
the argument list, lift the treatment of missing string lengths
from the above and implement the use of the intent.
(gfc_conv_function_call): Add the extra argument to the call to
the above.
PR fortran/28167
* trans-array.c (get_array_ctor_var_strlen): Treat a constant
substring reference.
* array.c (resolve_character_array_constructor): Remove static
attribute, make use of element charlens for the expression and
pick up constant string lengths for expressions that are not
themselves constant.
* gfortran.h : resolve_character_array_constructor prototype
added.
* resolve.c (gfc_resolve_expr): Call resolve_character_array_
constructor again after expanding the constructor, to ensure
that the character length is passed to the expression.
2006-06-29 Paul Thomas <pault@gcc.gnu.org>
PR fortran/28174
* gfortran.dg/actual_array_substr_2.f90: New test.
PR fortran/28167
* gfortran.dg/actual_array_constructor_2.f90: New test.