+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-21 Daniel Kraft <d@domob.eu>
* trans-stmt.c (gfc_conv_elemental_dependencies): Cleaned up comment.
gfc_ss_info *info;
gfc_symbol *fsym;
int n;
- stmtblock_t block;
tree data;
tree offset;
tree size;
&& 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
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;
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);
}
+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.
+
2009-01-27 Richard Guenther <rguenther@suse.de>
PR tree-optimization/38503
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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