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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@143707 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a744290..6facf64 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 82ecca8..42f0ac4 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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);
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1ebe503..e1c767a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/mvbits_6.f90 b/gcc/testsuite/gfortran.dg/mvbits_6.f90
new file mode 100644 (file)
index 0000000..c8986df
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_6.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/mvbits_7.f90 b/gcc/testsuite/gfortran.dg/mvbits_7.f90
new file mode 100644 (file)
index 0000000..2c7cab8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_7.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/mvbits_8.f90 b/gcc/testsuite/gfortran.dg/mvbits_8.f90
new file mode 100644 (file)
index 0000000..f69d1e8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/mvbits_8.f90
@@ -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