Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 161 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_13.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_13.f90
new file mode 100644
index 000000000..78b20acd5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/finalize_13.f90
@@ -0,0 +1,161 @@
+! { dg-do run }
+!
+! PR fortran/37336
+!
+module m
+  implicit none
+  type t
+    integer :: i
+  contains
+    final :: fini3, fini2, fini_elm
+  end type t
+
+  type, extends(t) :: t2
+    integer :: j
+  contains
+    final :: f2ini2, f2ini_elm
+  end type t2
+
+  logical :: elem_call
+  logical :: rank2_call
+  logical :: rank3_call
+  integer :: cnt, cnt2
+  integer :: fini_call
+
+contains
+  subroutine fini2 (x)
+    type(t), intent(in), contiguous :: x(:,:)
+    if (.not. rank2_call) call abort ()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+    !print *, 'fini2:', x%i
+    if (any (x%i /= reshape([11, 12, 21, 22, 31, 32], [2,3]))) call abort()
+    fini_call = fini_call + 1
+  end subroutine
+
+  subroutine fini3 (x)
+    type(t), intent(in) :: x(2,2,*)
+    integer :: i,j,k
+    if (.not. elem_call) call abort ()
+    if (.not. rank3_call) call abort ()
+    if (cnt2 /= 9) call abort()
+    if (cnt /= 1) call abort()
+      do i = 1, 2
+        do j = 1, 2
+          do k = 1, 2
+            !print *, k,j,i,x(k,j,i)%i
+            if (x(k,j,i)%i /= k+10*j+100*i) call abort()
+          end do 
+        end do
+      end do
+    fini_call = fini_call + 1
+  end subroutine
+
+  impure elemental subroutine fini_elm (x)
+    type(t), intent(in) :: x
+    if (.not. elem_call) call abort ()
+    if (rank3_call) call abort ()
+    if (cnt2 /= 6) call abort()
+    if (cnt /= x%i) call abort()
+    !print *, 'fini_elm:', cnt, x%i
+    fini_call = fini_call + 1
+    cnt = cnt + 1
+  end subroutine
+
+  subroutine f2ini2 (x)
+    type(t2), intent(in), target :: x(:,:)
+    if (.not. rank2_call) call abort ()
+    if (size(x,1) /= 2 .or. size(x,2) /= 3) call abort()
+    !print *, 'f2ini2:', x%i
+    !print *, 'f2ini2:', x%j
+    if (any (x%i /= reshape([11, 12, 21, 22, 31, 32], [2,3]))) call abort()
+    if (any (x%j /= 100*reshape([11, 12, 21, 22, 31, 32], [2,3]))) call abort()
+    fini_call = fini_call + 1
+  end subroutine
+
+  impure elemental subroutine f2ini_elm (x)
+    type(t2), intent(in) :: x
+    integer, parameter :: exprected(*) &
+            = [111, 112, 121, 122, 211, 212, 221, 222]
+
+    if (.not. elem_call) call abort ()
+    !print *, 'f2ini_elm:', cnt2, x%i, x%j
+    if (rank3_call) then
+      if (x%i /= exprected(cnt2)) call abort ()  
+      if (x%j /= 1000*exprected(cnt2)) call abort ()  
+    else
+      if (cnt2 /= x%i .or. cnt2*10 /= x%j) call abort()
+    end if
+    cnt2 = cnt2 + 1
+    fini_call = fini_call + 1
+  end subroutine
+end module m
+
+
+program test
+  use m
+  implicit none
+  class(t), save, allocatable :: y(:), z(:,:), zz(:,:,:)
+  target :: z, zz
+  integer :: i,j,k
+
+  elem_call = .false.
+  rank2_call = .false.
+  rank3_call = .false.
+  allocate (t2 :: y(5))
+  select type (y)
+    type is (t2)
+      do i = 1, 5
+        y(i)%i = i
+        y(i)%j = i*10
+      end do
+  end select
+  cnt = 1
+  cnt2 = 1
+  fini_call = 0
+  elem_call = .true.
+  deallocate (y)
+  if (fini_call /= 10) call abort ()
+
+  elem_call = .false.
+  rank2_call = .false.
+  rank3_call = .false.
+  allocate (t2 :: z(2,3))
+  select type (z)
+    type is (t2)
+      do i = 1, 3
+        do j = 1, 2
+          z(j,i)%i = j+10*i
+          z(j,i)%j = (j+10*i)*100
+        end do
+      end do
+  end select
+  cnt = 1
+  cnt2 = 1
+  fini_call = 0
+  rank2_call = .true.
+  deallocate (z)
+  if (fini_call /= 2) call abort ()
+
+  elem_call = .false.
+  rank2_call = .false.
+  rank3_call = .false.
+  allocate (t2 :: zz(2,2,2))
+  select type (zz)
+    type is (t2)
+      do i = 1, 2
+        do j = 1, 2
+          do k = 1, 2
+            zz(k,j,i)%i = k+10*j+100*i
+            zz(k,j,i)%j = (k+10*j+100*i)*1000
+          end do 
+        end do
+      end do
+  end select
+  cnt = 1
+  cnt2 = 1
+  fini_call = 0
+  rank3_call = .true.
+  elem_call = .true.
+  deallocate (zz)
+  if (fini_call /= 2*2*2+1) call abort ()
+end program test