* [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar()))
@ 2011-02-06 9:59 Paul Richard Thomas
2011-02-06 11:24 ` Tobias Burnus
[not found] ` <4D4E8169.3060808@net-b.de>
0 siblings, 2 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2011-02-06 9:59 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 881 bytes --]
The fix for this PR is sufficiently straightforward that the patch and
the ChangeLogs speak for themselves.
Note that I have removed the calls of gfc_start_block and replaced
them with gfc_init_block, since the former does all sorts of strange
things with declarations as the warning in trans.c indicates.
Bootstraps and regtests on FC9/x86_64 - OK for trunk?
Cheers
Paul
2011-02-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/47592
* trans-stmt.c (gfc_trans_allocate): For deferred character
length allocations with SOURCE, store to the values and string
length to avoid calculating twice. Replace gfc_start_block
with gfc_init_block to avoid unnecessary contexts and to keep
declarations of temporaries where they should be. Tidy up the
code a bit.
2011-02-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/47592
* gfortran.dg/allocate_with_source_1 : New test.
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 8593 bytes --]
Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c (revision 169860)
--- gcc/fortran/trans-stmt.c (working copy)
*************** gfc_trans_allocate (gfc_code * code)
*** 4451,4464 ****
tree pstat;
tree error_label;
tree memsz;
stmtblock_t block;
if (!code->ext.alloc.list)
return NULL_TREE;
pstat = stat = error_label = tmp = memsz = NULL_TREE;
! gfc_start_block (&block);
/* Either STAT= and/or ERRMSG is present. */
if (code->expr1 || code->expr2)
--- 4451,4472 ----
tree pstat;
tree error_label;
tree memsz;
+ tree expr3;
+ tree slen3;
stmtblock_t block;
+ stmtblock_t post;
+ gfc_expr *sz;
+ gfc_se se_sz;
+ gfc_ref *ref;
+ bool allocatable;
if (!code->ext.alloc.list)
return NULL_TREE;
pstat = stat = error_label = tmp = memsz = NULL_TREE;
! gfc_init_block (&block);
! gfc_init_block (&post);
/* Either STAT= and/or ERRMSG is present. */
if (code->expr1 || code->expr2)
*************** gfc_trans_allocate (gfc_code * code)
*** 4472,4477 ****
--- 4480,4488 ----
TREE_USED (error_label) = 1;
}
+ expr3 = NULL_TREE;
+ slen3 = NULL_TREE;
+
for (al = code->ext.alloc.list; al != NULL; al = al->next)
{
expr = gfc_copy_expr (al->expr);
*************** gfc_trans_allocate (gfc_code * code)
*** 4480,4486 ****
gfc_add_data_component (expr);
gfc_init_se (&se, NULL);
- gfc_start_block (&se.pre);
se.want_pointer = 1;
se.descriptor_only = 1;
--- 4491,4496 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 4495,4502 ****
{
if (code->expr3->ts.type == BT_CLASS)
{
- gfc_expr *sz;
- gfc_se se_sz;
sz = gfc_copy_expr (code->expr3);
gfc_add_vptr_component (sz);
gfc_add_size_component (sz);
--- 4505,4510 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 4514,4520 ****
if (!code->expr3->ts.u.cl->backend_decl)
{
/* Convert and use the length expression. */
- gfc_se se_sz;
gfc_init_se (&se_sz, NULL);
if (code->expr3->expr_type == EXPR_VARIABLE
|| code->expr3->expr_type == EXPR_CONSTANT)
--- 4522,4527 ----
*************** gfc_trans_allocate (gfc_code * code)
*** 4522,4528 ****
gfc_conv_expr (&se_sz, code->expr3);
memsz = se_sz.string_length;
}
! else if (code->expr3->ts.u.cl
&& code->expr3->ts.u.cl->length)
{
gfc_conv_expr (&se_sz, code->expr3->ts.u.cl->length);
--- 4529,4536 ----
gfc_conv_expr (&se_sz, code->expr3);
memsz = se_sz.string_length;
}
! else if (code->expr3->mold
! && code->expr3->ts.u.cl
&& code->expr3->ts.u.cl->length)
{
gfc_conv_expr (&se_sz, code->expr3->ts.u.cl->length);
*************** gfc_trans_allocate (gfc_code * code)
*** 4531,4550 ****
gfc_add_block_to_block (&se.pre, &se_sz.post);
memsz = se_sz.expr;
}
- else if (code->ext.alloc.ts.u.cl
- && code->ext.alloc.ts.u.cl->length)
- {
- gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length);
- memsz = se_sz.expr;
- }
else
{
! /* This is likely to be inefficient. */
! gfc_conv_expr (&se_sz, code->expr3);
! gfc_add_block_to_block (&se.pre, &se_sz.pre);
! se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre);
! gfc_add_block_to_block (&se.pre, &se_sz.post);
! memsz = se_sz.string_length;
}
}
else
--- 4539,4559 ----
gfc_add_block_to_block (&se.pre, &se_sz.post);
memsz = se_sz.expr;
}
else
{
! /* This is would be inefficient and possibly could
! generate wrong code if the result were not stored
! in expr3/slen3. */
! if (slen3 == NULL_TREE)
! {
! gfc_conv_expr (&se_sz, code->expr3);
! gfc_add_block_to_block (&se.pre, &se_sz.pre);
! expr3 = gfc_evaluate_now (se_sz.expr, &se.pre);
! gfc_add_block_to_block (&post, &se_sz.post);
! slen3 = gfc_evaluate_now (se_sz.string_length,
! &se.pre);
! }
! memsz = slen3;
}
}
else
*************** gfc_trans_allocate (gfc_code * code)
*** 4580,4610 ****
TREE_TYPE (tmp), tmp,
fold_convert (TREE_TYPE (tmp), memsz));
}
/* Allocate - for non-pointers with re-alloc checking. */
! {
! gfc_ref *ref;
! bool allocatable;
!
! ref = expr->ref;
!
! /* Find the last reference in the chain. */
! while (ref && ref->next != NULL)
! {
! gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT);
! ref = ref->next;
! }
!
! if (!ref)
! allocatable = expr->symtree->n.sym->attr.allocatable;
! else
! allocatable = ref->u.c.component->attr.allocatable;
!
! if (allocatable)
! tmp = gfc_allocate_array_with_status (&se.pre, se.expr, memsz,
! pstat, expr);
! else
! tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
! }
tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
se.expr,
--- 4589,4613 ----
TREE_TYPE (tmp), tmp,
fold_convert (TREE_TYPE (tmp), memsz));
}
+
/* Allocate - for non-pointers with re-alloc checking. */
! ref = expr->ref;
! /* Find the last reference in the chain. */
! while (ref && ref->next != NULL)
! {
! gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT);
! ref = ref->next;
! }
! if (!ref)
! allocatable = expr->symtree->n.sym->attr.allocatable;
! else
! allocatable = ref->u.c.component->attr.allocatable;
!
! if (allocatable)
! tmp = gfc_allocate_array_with_status (&se.pre, se.expr, memsz,
! pstat, expr);
! else
! tmp = gfc_allocate_with_status (&se.pre, memsz, pstat);
tmp = fold_build2_loc (input_location, MODIFY_EXPR, void_type_node,
se.expr,
*************** gfc_trans_allocate (gfc_code * code)
*** 4629,4639 ****
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
-
}
! tmp = gfc_finish_block (&se.pre);
! gfc_add_expr_to_block (&block, tmp);
if (code->expr3 && !code->expr3->mold)
{
--- 4632,4640 ----
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
}
! gfc_add_block_to_block (&block, &se.pre);
if (code->expr3 && !code->expr3->mold)
{
*************** gfc_trans_allocate (gfc_code * code)
*** 4668,4673 ****
--- 4669,4681 ----
gfc_add_block_to_block (&call.pre, &call.post);
tmp = gfc_finish_block (&call.pre);
}
+ else if (expr3 != NULL_TREE)
+ {
+ tmp = build_fold_indirect_ref_loc (input_location, se.expr);
+ gfc_trans_string_copy (&block, slen3, tmp, code->expr3->ts.kind,
+ slen3, expr3, code->expr3->ts.kind);
+ tmp = NULL_TREE;
+ }
else
{
/* Switch off automatic reallocation since we have just done
*************** gfc_trans_allocate (gfc_code * code)
*** 4799,4804 ****
--- 4807,4815 ----
gfc_add_expr_to_block (&block, tmp);
}
+ gfc_add_block_to_block (&block, &se.post);
+ gfc_add_block_to_block (&block, &post);
+
return gfc_finish_block (&block);
}
Index: gcc/testsuite/gfortran.dg/allocate_with_source_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/allocate_with_source_1.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/allocate_with_source_1.f90 (revision 0)
***************
*** 0 ****
--- 1,29 ----
+ ! { dg-do run }
+ ! Test the fix for PR47592, in which the SOURCE expression was
+ ! being called twice.
+ !
+ ! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+ !
+ module foo
+ implicit none
+ contains
+ function bar()
+ integer bar
+ integer :: i=9
+ i = i + 1
+ bar = i
+ end function bar
+ end module foo
+
+ program note7_35
+ use foo
+ implicit none
+ character(:), allocatable :: name
+ character(:), allocatable :: src
+ integer n
+ n = 10
+ allocate(name, SOURCE=repeat('x',bar()))
+ if (name .ne. 'xxxxxxxxxx') call abort
+ if (len (name) .ne. 10 ) call abort
+ end program note7_35
+ ! { dg-final { cleanup-modules "foo" } }
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar()))
2011-02-06 9:59 [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar())) Paul Richard Thomas
@ 2011-02-06 11:24 ` Tobias Burnus
[not found] ` <4D4E8169.3060808@net-b.de>
1 sibling, 0 replies; 4+ messages in thread
From: Tobias Burnus @ 2011-02-06 11:24 UTC (permalink / raw)
To: Paul Richard Thomas; +Cc: fortran, gcc-patches
Am 06.02.2011 10:59, Paul Richard Thomas wrote:
> Note that I have removed the calls of gfc_start_block and replaced
> them with gfc_init_block, since the former does all sorts of strange
> things with declarations as the warning in trans.c indicates.
I think there are several places in gfortran where an init_block would
be better than a start_block.
> Bootstraps and regtests on FC9/x86_64 - OK for trunk?
OK, though you could consider shortening the code as indicated below.
Thanks for the patch!
> +
> ! ref = expr->ref;
> ! /* Find the last reference in the chain. */
> ! while (ref&& ref->next != NULL)
> ! {
> ! gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type == AR_ELEMENT);
> ! ref = ref->next;
> ! }
> ! if (!ref)
> ! allocatable = expr->symtree->n.sym->attr.allocatable;
> ! else
> ! allocatable = ref->u.c.component->attr.allocatable;
> !
> ! if (allocatable)
>
That's mostly unchanged from previous version, but couldn't one replace
it by a simple "if (gfc_expr_attr (expr).allocatable)"? I think
gfc_expr_attr does not always do the right thing (regarding when to
ignore and not ignore array/substring refs), but I think here it does.
Tobias
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar()))
[not found] ` <4D4E8169.3060808@net-b.de>
@ 2011-02-06 12:17 ` Paul Richard Thomas
2011-02-06 14:24 ` Paul Richard Thomas
0 siblings, 1 reply; 4+ messages in thread
From: Paul Richard Thomas @ 2011-02-06 12:17 UTC (permalink / raw)
To: Tobias Burnus; +Cc: fortran, gcc-patches
Dear Tobias,
I thought that you were not doing gfortran this weekend :-)
> Note that I have removed the calls of gfc_start_block and replaced
> them with gfc_init_block, since the former does all sorts of strange
> things with declarations as the warning in trans.c indicates.
>
> I think there are several places in gfortran where an init_block would be
> better than a start_block.
Indeed - I have been burned more than once by using start, rather than init.
>
> Bootstraps and regtests on FC9/x86_64 - OK for trunk?
>
> OK, though you could consider shortening the code as indicated below. Thanks
> for the patch!
>
> +
> ! ref = expr->ref;
> ! /* Find the last reference in the chain. */
> ! while (ref && ref->next != NULL)
> ! {
> ! gcc_assert (ref->type != REF_ARRAY || ref->u.ar.type ==
> AR_ELEMENT);
> ! ref = ref->next;
> ! }
> ! if (!ref)
> ! allocatable = expr->symtree->n.sym->attr.allocatable;
> ! else
> ! allocatable = ref->u.c.component->attr.allocatable;
> !
> ! if (allocatable)
>
>
> That's mostly unchanged from previous version, but couldn't one replace it
> by a simple "if (gfc_expr_attr (expr).allocatable)"? I think gfc_expr_attr
> does not always do the right thing (regarding when to ignore and not ignore
> array/substring refs), but I think here it does.
I'll give it a try. Thanks for the review. Now to module backend_decls.....
Cheers
Paul
^ permalink raw reply [flat|nested] 4+ messages in thread
* Re: [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar()))
2011-02-06 12:17 ` Paul Richard Thomas
@ 2011-02-06 14:24 ` Paul Richard Thomas
0 siblings, 0 replies; 4+ messages in thread
From: Paul Richard Thomas @ 2011-02-06 14:24 UTC (permalink / raw)
To: Tobias Burnus; +Cc: fortran, gcc-patches
Dear All,
Sending gcc/fortran/ChangeLog
Sending gcc/fortran/trans-stmt.c
Sending gcc/testsuite/ChangeLog
Adding gcc/testsuite/gfortran.dg/allocate_with_source_1.f90
Transmitting file data ....
Committed revision 169862.
>> That's mostly unchanged from previous version, but couldn't one replace it
>> by a simple "if (gfc_expr_attr (expr).allocatable)"? I think gfc_expr_attr
>> does not always do the right thing (regarding when to ignore and not ignore
>> array/substring refs), but I think here it does.
>
With this suggestion - thanks.
Cheers
Paul
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2011-02-06 14:24 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-02-06 9:59 [Patch, fortran] PR47592 - Multiple function invocation with ALLOCATE (SOURCE=REPEAT('x',bar())) Paul Richard Thomas
2011-02-06 11:24 ` Tobias Burnus
[not found] ` <4D4E8169.3060808@net-b.de>
2011-02-06 12:17 ` Paul Richard Thomas
2011-02-06 14:24 ` Paul Richard Thomas
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).