re PR target/35944 (wrong result for MOD with kind=10 for some array argument values)

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

4 files changed, 75 insertions, 2 deletions

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
index fc58bf4..11f655e 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_basics_1.f90
@@ -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" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
index 969e703..91145e7 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_constructor_1.f90
@@ -104,5 +104,5 @@ contains
     end function blaha

 

 end program test_constructor

-! { dg-final { scan-tree-dump-times "builtin_free" 19 "original" } }

+! { dg-final { scan-tree-dump-times "builtin_free" 21 "original" } }

 ! { dg-final { cleanup-tree-dump "original" } }

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
index 0000000..db106cc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_default_init_2.f90
@@ -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
index 0000000..3eeedba
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/array_constructor_23.f
@@ -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
+