Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 95 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_to_type_2.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_to_type_2.f90
new file mode 100644
index 000000000..e6181a4d3
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_to_type_2.f90
@@ -0,0 +1,95 @@
+! { dg-do run }
+!
+! PR fortran/51514
+!
+! Check that passing a CLASS to a TYPE works
+!
+! Based on a test case of Reinhold Bader.
+!
+
+module mod_subpr
+  implicit none
+
+  type :: foo
+    integer :: i = 2
+  end type
+
+  type, extends(foo) :: foo_1
+    real :: r(2)
+  end type
+
+contains
+
+  subroutine subpr (x)
+    type(foo) :: x
+    x%i = 3
+  end subroutine
+
+  elemental subroutine subpr_elem (x)
+    type(foo), intent(inout):: x
+    x%i = 3
+  end subroutine
+
+  subroutine subpr_array (x)
+    type(foo), intent(inout):: x(:)
+    x(:)%i = 3
+  end subroutine
+
+  subroutine subpr2 (x)
+    type(foo) :: x
+    if (x%i /= 55) call abort ()
+  end subroutine
+
+  subroutine subpr2_array (x)
+    type(foo) :: x(:)
+    if (any(x(:)%i /= 55)) call abort ()
+  end subroutine
+
+  function f ()
+    class(foo), allocatable :: f
+    allocate (f)
+    f%i = 55
+  end function f
+
+  function g () result(res)
+    class(foo), allocatable :: res(:)
+    allocate (res(3))
+    res(:)%i = 55
+  end function g
+end module
+
+program prog
+  use mod_subpr
+  implicit none
+  class(foo), allocatable :: xx, yy(:)
+
+  allocate (foo_1 :: xx)
+  xx%i = 33
+  call subpr (xx)
+  if (xx%i /= 3) call abort ()
+
+  xx%i = 33
+  call subpr_elem (xx)
+  if (xx%i /= 3) call abort ()
+
+  call subpr (f ())
+
+  allocate (foo_1 :: yy(2))
+  yy(:)%i = 33
+  call subpr_elem (yy)
+  if (any (yy%i /= 3)) call abort ()
+
+  yy(:)%i = 33
+  call subpr_elem (yy(1))
+  if (yy(1)%i /= 3) call abort ()
+
+  yy(:)%i = 33
+  call subpr_array (yy)
+  if (any (yy%i /= 3)) call abort ()
+
+  yy(:)%i = 33
+  call subpr_array (yy(1:2))
+  if (any (yy(1:2)%i /= 3)) call abort ()
+
+ call subpr2_array (g ())
+end program