This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, Fortran] PR fortran/38883: Fix MVBITS for subcomponent-references
- From: Daniel Kraft <d at domob dot eu>
- To: Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>
- Cc: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 27 Jan 2009 17:55:48 +0100
- Subject: Re: [Patch, Fortran] PR fortran/38883: Fix MVBITS for subcomponent-references
- References: <497E23E6.9070200@domob.eu> <339c37f20901261422w64480accta8ccd2ad34a9dbf9@mail.gmail.com>
Hi Paul,
Paul Richard Thomas wrote:
Your patch is fine - OK for trunk.
thanks for the prompt review! I didn't have any regressions for my
test, either.
You might consider the variant that I have attached, which regtests
and bootstraps OK, and the alternative testcase below.
Whichever you choose to implement, note the removal of the now
redundant 'block' and the change to the comment.
Your version looks nice, but seems to simple; and the new test
mvbits_8.f90 in the patch attached really makes it ICE, so I went for my
solution together with the comment change and removal of block, as well
as your test as second one.
Find attached what I'm going to commit if a new regression-test for the
final version does not produce any errors.
Thanks,
Daniel
--
Done: Arc-Bar-Cav-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri-Ran
2009-01-27 Daniel Kraft <d@domob.eu>
PR fortran/38883
* trans-stmt.c (gfc_conv_elemental_dependencies): Create temporary
for the real type needed to make it work for subcomponent-references.
2009-01-27 Daniel Kraft <d@domob.eu>
PR fortran/38883
* gfortran.dg/mvbits_6.f90: New test.
* gfortran.dg/mvbits_7.f90: New test.
* gfortran.dg/mvbits_8.f90: New test.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 143663)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -213,7 +213,6 @@ gfc_conv_elemental_dependencies (gfc_se
gfc_ss_info *info;
gfc_symbol *fsym;
int n;
- stmtblock_t block;
tree data;
tree offset;
tree size;
@@ -252,7 +251,7 @@ gfc_conv_elemental_dependencies (gfc_se
&& gfc_check_fncall_dependency (e, fsym->attr.intent,
sym, arg0, check_variable))
{
- tree initial;
+ tree initial, temptype;
stmtblock_t temp_post;
/* Make a local loopinfo for the temporary creation, so that
@@ -278,24 +277,31 @@ gfc_conv_elemental_dependencies (gfc_se
else
initial = NULL_TREE;
- /* Generate the temporary. Merge the block so that the
- declarations are put at the right binding level. Cleaning up the
- temporary should be the very last thing done, so we add the code to
- a new block and add it to se->post as last instructions. */
+ /* Find the type of the temporary to create; we don't use the type
+ of e itself as this breaks for subcomponent-references in e (where
+ the type of e is that of the final reference, but parmse.expr's
+ type corresponds to the full derived-type). */
+ /* TODO: Fix this somehow so we don't need a temporary of the whole
+ array but instead only the components referenced. */
+ temptype = TREE_TYPE (parmse.expr); /* Pointer to descriptor. */
+ gcc_assert (TREE_CODE (temptype) == POINTER_TYPE);
+ temptype = TREE_TYPE (temptype);
+ temptype = gfc_get_element_type (temptype);
+
+ /* Generate the temporary. Cleaning up the temporary should be the
+ very last thing done, so we add the code to a new block and add it
+ to se->post as last instructions. */
size = gfc_create_var (gfc_array_index_type, NULL);
data = gfc_create_var (pvoid_type_node, NULL);
- gfc_start_block (&block);
gfc_init_block (&temp_post);
- tmp = gfc_typenode_for_spec (&e->ts);
tmp = gfc_trans_create_temp_array (&se->pre, &temp_post,
- &tmp_loop, info, tmp,
+ &tmp_loop, info, temptype,
initial,
false, true, false,
&arg->expr->where);
gfc_add_modify (&se->pre, size, tmp);
tmp = fold_convert (pvoid_type_node, info->data);
gfc_add_modify (&se->pre, data, tmp);
- gfc_merge_block_scope (&block);
/* Calculate the offset for the temporary. */
offset = gfc_index_zero_node;
@@ -315,7 +321,7 @@ gfc_conv_elemental_dependencies (gfc_se
tmp = build_call_expr (gfor_fndecl_in_unpack, 2, parmse.expr, data);
gfc_add_expr_to_block (&se->post, tmp);
- gfc_add_block_to_block (&se->pre, &parmse.pre);
+ /* parmse.pre is already added above. */
gfc_add_block_to_block (&se->post, &parmse.post);
gfc_add_block_to_block (&se->post, &temp_post);
}
Index: gcc/testsuite/gfortran.dg/mvbits_7.f90
===================================================================
--- gcc/testsuite/gfortran.dg/mvbits_7.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/mvbits_7.f90 (revision 0)
@@ -0,0 +1,30 @@
+! { dg-do run }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+
+! Contributed by Paul Richard Thomas <paul.richard.thomas@gmail.com>
+
+ type t
+ integer :: I
+ character(9) :: chr
+ end type
+ type(t) :: x(4,3)
+ type(t) :: y(4,3)
+ x = reshape ([((t (i*j, "a"),i = 1,4), j=1,3)], [4,3])
+ call foo (x)
+ y = reshape ([((t (i*j*2, "a"),i = 1,4), j=1,3)], [4,3])
+ call bar(y, 4, 3, 1, -1, -4, -3)
+ if (any (x%i .ne. y%i)) call abort
+contains
+ SUBROUTINE foo (x)
+ TYPE(t) x(4, 3) ! No dependency at all
+ CALL MVBITS (x%i, 0, 6, x%i, 8)
+ x%i = x%i * 2
+ END SUBROUTINE
+ SUBROUTINE bar (x, NF4, NF3, NF1, MF1, MF4, MF3)
+ TYPE(t) x(NF4, NF3) ! Dependency through variable indices
+ CALL MVBITS (x(NF4:NF1:MF1, NF1:NF3)%i, 1, &
+ 6, x(-MF4:-MF1:-NF1, -MF1:-MF3)%i, 9)
+ END SUBROUTINE
+end
Index: gcc/testsuite/gfortran.dg/mvbits_6.f90
===================================================================
--- gcc/testsuite/gfortran.dg/mvbits_6.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/mvbits_6.f90 (revision 0)
@@ -0,0 +1,33 @@
+! { dg-do compile }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+! This is the original test from the PR, the complicated version.
+
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+
+ module yg0009_stuff
+
+ type unseq
+ integer I
+ end type
+
+ contains
+
+ SUBROUTINE YG0009(TDA2L,NF4,NF3,NF1,MF1,MF4,MF3)
+ TYPE(UNSEQ) TDA2L(NF4,NF3)
+
+ CALL MVBITS (TDA2L(NF4:NF1:MF1,NF1:NF3)%I,2, &
+ 4, TDA2L(-MF4:-MF1:-NF1,-MF1:-MF3)%I, 3)
+
+ END SUBROUTINE
+
+ end module yg0009_stuff
+
+ program try_yg0009
+ use yg0009_stuff
+ type(unseq) tda2l(4,3)
+
+ call yg0009(tda2l,4,3,1,-1,-4,-3)
+
+ end
Index: gcc/testsuite/gfortran.dg/mvbits_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/mvbits_8.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/mvbits_8.f90 (revision 0)
@@ -0,0 +1,36 @@
+! { dg-do run }
+
+! PR fortran/38883
+! This ICE'd because the temporary-creation in the MVBITS call was wrong.
+
+PROGRAM main
+ IMPLICIT NONE
+
+ TYPE inner
+ INTEGER :: i
+ INTEGER :: j
+ END TYPE inner
+
+ TYPE outer
+ TYPE(inner) :: comp(2)
+ END TYPE outer
+
+ TYPE(outer) :: var
+
+ var%comp%i = (/ 1, 2 /)
+ var%comp%j = (/ 3, 4 /)
+
+ CALL foobar (var, 1, 2)
+
+ IF (ANY (var%comp%i /= (/ 1, 2 /))) CALL abort ()
+ IF (ANY (var%comp%j /= (/ 3, 4 /))) CALL abort ()
+
+CONTAINS
+
+ SUBROUTINE foobar (x, lower, upper)
+ TYPE(outer), INTENT(INOUT) :: x
+ INTEGER, INTENT(IN) :: lower, upper
+ CALL MVBITS (x%comp%i, 1, 2, x%comp(lower:upper)%i, 1)
+ END SUBROUTINE foobar
+
+END PROGRAM main