OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/38883 (ICE for MVBITS with derived type argument that has run-time subscripts) 

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.

From-SVN: r143707
This commit is contained in:
Daniel Kraft 2009-01-27 19:07:54 +01:00 committed by Daniel Kraft
parent 7b7d60003f
commit 79e5286cba
6 changed files with 129 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
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.

28
gcc/fortran/trans-stmt.c
View File

@ -213,7 +213,6 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
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 * se, gfc_se * loopse,
&& 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 * se, gfc_se * loopse,
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 * se, gfc_se * loopse,
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);
}

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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

33
gcc/testsuite/gfortran.dg/mvbits_6.f90 Normal file
View File

@ -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

30
gcc/testsuite/gfortran.dg/mvbits_7.f90 Normal file
View File

@ -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

36
gcc/testsuite/gfortran.dg/mvbits_8.f90 Normal file
View File

@ -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