re PR fortran/67933 (ICE for array of a derived type with allocatable class in derive...

2015-01-27  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67933
	* gfortran.dg/allocate_with_source_15.f03: New test

From-SVN: r229452

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1185917c9131a647999d2234ed16fa40a16927f7..230581c6e9ad357eb7701e22967027587a44055c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-27  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/67933
+       * gfortran.dg/allocate_with_source_15.f03: New test
+
 2015-10-27  Thomas Schwinge  <thomas@codesourcery.com>
            James Norris  <jnorris@codesourcery.com>
 

diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_15.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_15.f03
new file mode 100644 (file)
index 0000000..38f9cec
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_15.f03
@@ -0,0 +1,79 @@
+! { dg-do run }
+!
+! Tests the fix for PR67933, which was a side effect of the fix for PR67171.
+!
+! Contributed by Andrew  <mandrew9@vt.edu>
+!
+module test_mod
+  implicit none
+
+  type :: class_t
+    integer :: i
+  end type class_t
+
+  type, extends(class_t) :: class_e
+    real :: r
+  end type class_e
+
+  type :: wrapper_t
+    class(class_t), allocatable  :: class_var
+!    type(class_t), allocatable  :: class_var
+!    integer,       allocatable  :: class_id
+  end type wrapper_t
+
+  type :: list_t
+    type(wrapper_t) :: classes(10)
+  contains
+    procedure :: Method
+    procedure :: Typeme
+    procedure :: Dealloc
+  end type list_t
+
+contains
+  subroutine Method(this)
+    class(list_t) :: this
+    integer :: i
+    do i = 1, 20
+      if (i .gt. 10) then
+        allocate (this%classes(i)%class_var, source = class_t (i))
+      else
+        allocate (this%classes(i)%class_var, source = class_e (i, real (2 * i)))
+      end if
+    end do
+  end subroutine Method
+  subroutine Dealloc(this)
+    class(list_t) :: this
+    integer :: i
+    do i = 1, 20
+      if (allocated (this%classes(i)%class_var)) &
+         deallocate (this%classes(i)%class_var)
+    end do
+  end subroutine Dealloc
+  subroutine Typeme(this)
+    class(list_t) :: this
+    integer :: i, j(20)
+    real :: r(20)
+    real :: zero = 0.0
+    do i = 1, 20
+      j(i) = this%classes(i)%class_var%i
+      select type (p => this%classes(i)%class_var)
+        type is (class_e)
+          r(i) = p%r
+        class default
+          r(i) = zero
+      end select
+    end do
+!    print "(10i6,/)", j
+    if (any (j .ne. [(i, i = 1,20)])) call abort
+!    print "(10f6.2,/)", r
+    if (any (r(1:10) .ne. [(real (2 * i), i = 1,10)])) call abort
+    if (any (r(11:20) .ne. zero)) call abort
+  end subroutine Typeme
+end module test_mod
+
+  use test_mod
+  type(list_t) :: x
+  call x%Method
+  call x%Typeme
+  call x%dealloc
+end