re PR target/35944 (wrong result for MOD with kind=10 for some array argument values)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Apr 2008 21:55:24 +0000 (21:55 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Apr 2008 21:55:24 +0000 (21:55 +0000)
2008-04-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/35944
PR fortran/35946
PR fortran/35947
* trans_array.c (gfc_trans_array_constructor): Temporarily
realign loop, if loop->from is not zero, before creating
the temporary array and provide an offset.

PR fortran/35959
* trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name
and allow for NULL body.  Change all references from
init_default_dt to gfc_init_default_dt.
* trans.h : Add prototype for gfc_init_default_dt.
* trans-array.c (gfc_trans_deferred_vars): After nullification
call gfc_init_default_dt for derived types with allocatable
components.

2008-04-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/35944
PR fortran/35946
PR fortran/35947
* gfortran.dg/array_constructor_23.f: New test.

PR fortran/35959
* gfortran.dg/alloc_comp_default_init_2.f90: New test.
* gfortran.dg/alloc_comp_basics_1.f90: Change occurrences of
"builtin_free" to 27.
* gfortran.dg/alloc_comp_constructor_1.f90: Change occurrences
of "builtin_free" to 21.

From-SVN: r134472

gcc/fortran/ChangeLog
gcc/fortran/trans-array.c
gcc/fortran/trans-decl.c
gcc/fortran/trans.h
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/array_constructor_23.f [new file with mode: 0644]

index 763e2f2d7543052ed4d5c070ade4573241ac51b4..abcc336e4d1349772881df7998b1146a49b8d2a8 100644 (file)
@@ -1,3 +1,21 @@
+2008-04-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/35944
+       PR fortran/35946
+       PR fortran/35947
+       * trans_array.c (gfc_trans_array_constructor): Temporarily
+       realign loop, if loop->from is not zero, before creating
+       the temporary array and provide an offset.
+
+       PR fortran/35959
+       * trans-decl.c (gfc_init_default_dt): Add gfc_ prefix to name
+       and allow for NULL body.  Change all references from
+       init_default_dt to gfc_init_default_dt.
+       * trans.h : Add prototype for gfc_init_default_dt.
+       * trans-array.c (gfc_trans_deferred_vars): After nullification
+       call gfc_init_default_dt for derived types with allocatable
+       components.
+
 2008-04-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/35892
index 3de1fb71f20c86fde3a8451659531858671fb0e5..7bac68dd650ec240a4f42c1473a5838543142ed0 100644 (file)
@@ -1679,6 +1679,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
   tree offsetvar;
   tree desc;
   tree type;
+  tree loopfrom;
   bool dynamic;
 
   if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
@@ -1757,9 +1758,34 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
        }
     }
 
+  /* Temporarily reset the loop variables, so that the returned temporary
+     has the right size and bounds.  This seems only to be necessary for
+     1D arrays.  */
+  if (!integer_zerop (loop->from[0]) && loop->dimen == 1)
+    {
+      loopfrom = loop->from[0];
+      loop->from[0] = gfc_index_zero_node;
+      loop->to[0] = fold_build2 (MINUS_EXPR, gfc_array_index_type,
+                                loop->to[0], loopfrom);
+    }
+  else
+    loopfrom = NULL_TREE;
+
   gfc_trans_create_temp_array (&loop->pre, &loop->post, loop, &ss->data.info,
                               type, dynamic, true, false);
 
+  if (loopfrom != NULL_TREE)
+    {
+      loop->from[0] = loopfrom;
+      loop->to[0] = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+                                loop->to[0], loopfrom);
+      /* In the case of a non-zero from, the temporary needs an offset
+        so that subsequent indexing is correct.  */
+      ss->data.info.offset = fold_build1 (NEGATE_EXPR,
+                                         gfc_array_index_type,
+                                         loop->from[0]);
+    }
+
   desc = ss->data.info.descriptor;
   offset = gfc_index_zero_node;
   offsetvar = gfc_create_var_np (gfc_array_index_type, "offset");
@@ -5569,6 +5595,11 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
          rank = sym->as ? sym->as->rank : 0;
          tmp = gfc_nullify_alloc_comp (sym->ts.derived, descriptor, rank);
          gfc_add_expr_to_block (&fnblock, tmp);
+         if (sym->value)
+           {
+             tmp = gfc_init_default_dt (sym, NULL);
+             gfc_add_expr_to_block (&fnblock, tmp);
+           }
        }
     }
   else if (!GFC_DESCRIPTOR_TYPE_P (type))
index 6f430cbc7a63c76d0d3c27659d1a6a6c27393770..e693f729ba46e1063b68350f137ac19a2498d4d8 100644 (file)
@@ -512,9 +512,6 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
      SAVE_EXPLICIT.  */
   if (!sym->attr.use_assoc
        && (sym->attr.save != SAVE_NONE || sym->attr.data
-             || (sym->ts.type == BT_DERIVED
-                   && sym->ts.derived->attr.alloc_comp
-                   && sym->value)
              || (sym->value && sym->ns->proc_name->attr.is_main_program)))
     TREE_STATIC (decl) = 1;
 
@@ -2532,8 +2529,8 @@ gfc_trans_vla_type_sizes (gfc_symbol *sym, stmtblock_t *body)
 
 /* Initialize a derived type by building an lvalue from the symbol
    and using trans_assignment to do the work.  */
-static tree
-init_default_dt (gfc_symbol * sym, tree body)
+tree
+gfc_init_default_dt (gfc_symbol * sym, tree body)
 {
   stmtblock_t fnblock;
   gfc_expr *e;
@@ -2553,7 +2550,8 @@ init_default_dt (gfc_symbol * sym, tree body)
     }
   gfc_add_expr_to_block (&fnblock, tmp);
   gfc_free_expr (e);
-  gfc_add_expr_to_block (&fnblock, body);
+  if (body)
+    gfc_add_expr_to_block (&fnblock, body);
   return gfc_finish_block (&fnblock);
 }
 
@@ -2571,7 +2569,7 @@ init_intent_out_dt (gfc_symbol * proc_sym, tree body)
          && f->sym->ts.type == BT_DERIVED
          && !f->sym->ts.derived->attr.alloc_comp
          && f->sym->value)
-      body = init_default_dt (f->sym, body);
+      body = gfc_init_default_dt (f->sym, body);
 
   gfc_add_expr_to_block (&fnblock, body);
   return gfc_finish_block (&fnblock);
@@ -2672,7 +2670,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
                             && sym->value
                             && !sym->attr.data
                             && sym->attr.save == SAVE_NONE)
-                   fnbody = init_default_dt (sym, fnbody);
+                   fnbody = gfc_init_default_dt (sym, fnbody);
 
                  gfc_get_backend_locus (&loc);
                  gfc_set_backend_locus (&sym->declared_at);
@@ -2732,7 +2730,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
                 && sym->value
                 && !sym->attr.data
                 && sym->attr.save == SAVE_NONE)
-       fnbody = init_default_dt (sym, fnbody);
+       fnbody = gfc_init_default_dt (sym, fnbody);
       else
        gcc_unreachable ();
     }
index 413433641c175568917c43445a2bb2ca70f4cb50..1dfb0a59dab85e73b99972a79f8d1bb3c99f6bf9 100644 (file)
@@ -405,6 +405,9 @@ tree gfc_get_symbol_decl (gfc_symbol *);
 /* Build a static initializer.  */
 tree gfc_conv_initializer (gfc_expr *, gfc_typespec *, tree, bool, bool);
 
+/* Assign a default initializer to a derived type.  */
+tree gfc_init_default_dt (gfc_symbol *, tree);
+
 /* Substitute a temporary variable in place of the real one.  */
 void gfc_shadow_sym (gfc_symbol *, tree, gfc_saved_var *);
 
index 22da23b4b4c80a47548714e4c84197c89e35199e..2d3ab1903f3fcf8ff6eec0f3a755e621f8383ac5 100644 (file)
@@ -1,3 +1,17 @@
+2008-04-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/35944
+       PR fortran/35946
+       PR fortran/35947
+       * gfortran.dg/array_constructor_23.f: New test.
+
+       PR fortran/35959
+       * gfortran.dg/alloc_comp_default_init_2.f90: New test.
+       * gfortran.dg/alloc_comp_basics_1.f90: Change occurrences of
+       "builtin_free" to 27.
+       * gfortran.dg/alloc_comp_constructor_1.f90: Change occurrences
+       of "builtin_free" to 21.
+
 2008-04-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/35892
index fc58bf4483039a9b5a79e7f778bec6e4a5c4da0d..11f655e320bfd2f6485205348bfb624d654b2b51 100644 (file)
@@ -139,6 +139,6 @@ contains
     end subroutine check_alloc2
 
 end program alloc
-! { dg-final { scan-tree-dump-times "builtin_free" 24 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 27 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
 ! { dg-final { cleanup-modules "alloc_m" } }
index 969e703094c63681f8f1dca8e0840fff08c4aba3..91145e7c246a44eb937245bbfe5592ca63499f7f 100644 (file)
@@ -104,5 +104,5 @@ contains
     end function blaha\r
 \r
 end program test_constructor\r
-! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }\r
+! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }\r
 ! { dg-final { cleanup-tree-dump "original" } }\r
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90
new file mode 100644 (file)
index 0000000..db106cc
--- /dev/null
@@ -0,0 +1,26 @@
+! { dg-do run }
+! Tests the fix for PR35959, in which the structure subpattern was declared static
+! so that this test faied on the second recursive call.
+!
+! Contributed by MichaĆ«l Baudin <michael.baudin@gmail.com>
+!
+program testprog
+  type :: t_type
+    integer, dimension(:), allocatable :: chars
+  end type t_type
+  integer, save :: callnb = 0
+  type(t_type) :: this
+  allocate ( this % chars ( 4))
+  if (.not.recursivefunc (this) .or. (callnb .ne. 10)) call abort ()
+contains
+  recursive function recursivefunc ( this ) result ( match )
+    type(t_type), intent(in) :: this
+    type(t_type) :: subpattern
+    logical :: match
+    callnb = callnb + 1
+    match = (callnb == 10)
+    if ((.NOT. allocated (this % chars)) .OR. match) return
+    allocate ( subpattern % chars ( 4 ) )
+    match = recursivefunc ( subpattern )
+  end function recursivefunc
+end program testprog
diff --git a/gcc/testsuite/gfortran.dg/array_constructor_23.f b/gcc/testsuite/gfortran.dg/array_constructor_23.f
new file mode 100644 (file)
index 0000000..3eeedba
--- /dev/null
@@ -0,0 +1,47 @@
+! { dg-do run }
+! Tests the fix for PR35944/6/7, in which the variable array constructors below
+! were incorrectly translated and wrong code was produced.
+!
+! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+!
+      program try_fa6013
+      call fa6013 (10, 1, -1)
+      call fa6077 (10, 1, -1, (/1,2,3,4,5,6,7,8,9,10/))
+      call fa2083
+      end program
+
+      subroutine  FA6013 (nf10, nf1, mf1)
+      integer, parameter :: kv = 4
+      REAL(KV) DDA1(10)
+      REAL(KV) DDA2(10)
+      REAL(KV) DDA(10), dval
+      dda = (/1,2,3,4,5,6,7,8,9,10/)
+      DDA1 = ATAN2 ((/(REAL(J1,KV),J1=1,10)/),
+     $                 REAL((/(J1,J1=nf10,nf1,mf1)/), KV))   !fails
+      DDA2 = ATAN2 (DDA, DDA(10:1:-1))
+      if (any (DDA1 .ne. DDA2)) call abort ()
+      END
+
+      subroutine FA6077 (nf10,nf1,mf1, ida)
+      INTEGER IDA1(10)
+      INTEGER IDA2(10), ida(10)
+      IDA1 = IEOR((/1,2,3,4,5,6,7,8,9,10/),
+     $            (/(IDA(J1),J1=10,1,-1)/) )
+      IDA2 = IEOR ((/1,2,3,4,5,6,7,8,9,10/), (/10,9,8,7,6,5,4,3,2,1/) )
+      if (any (ida1 .ne. ida2)) call abort ()
+      END SUBROUTINE
+
+      subroutine fa2083
+      implicit none
+      integer j1,k
+      parameter (k=10)              !failed
+      REAL(k) QDA1(10)
+      REAL(k) QDA(10), qval
+      qda = (/ 1,2,3,4,5,6,7,8,9,10 /)
+      QDA1 = MOD ( 1.1_k*( QDA(1) -5.0_k), P=( QDA -2.5_k))
+      DO J1 = 1,10
+        QVAL = MOD(1.1_k*(QDA(1)-5.0_k),P=(QDA(J1)-2.5_k))
+        if (qval .ne. qda1(j1)) call abort ()
+      ENDDO
+      END
+