Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 111 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/extends_type_of_3.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/extends_type_of_3.f90
new file mode 100644
index 000000000..346542fe5
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/extends_type_of_3.f90
@@ -0,0 +1,111 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/41580
+!
+! Compile-time simplification of SAME_TYPE_AS
+! and EXTENDS_TYPE_OF.
+!
+
+implicit none
+type t1
+  integer :: a
+end type t1
+type, extends(t1):: t11
+  integer :: b
+end type t11
+type, extends(t11):: t111
+  integer :: c
+end type t111
+type t2
+  integer :: a
+end type t2
+
+type(t1) a1
+type(t11) a11
+type(t2) a2
+class(t1), allocatable :: b1
+class(t11), allocatable :: b11
+class(t2), allocatable :: b2
+
+logical, parameter :: p1 = same_type_as(a1,a2)  ! F
+logical, parameter :: p2 = same_type_as(a2,a1)  ! F
+logical, parameter :: p3 = same_type_as(a1,a11) ! F
+logical, parameter :: p4 = same_type_as(a11,a1) ! F
+logical, parameter :: p5 = same_type_as(a11,a11)! T
+logical, parameter :: p6 = same_type_as(a1,a1)  ! T
+
+if (p1 .or. p2 .or. p3 .or. p4 .or. .not. p5 .or. .not. p6) call should_not_exist()
+
+! Not (trivially) compile-time simplifiable:
+if (same_type_as(b1,a1)  .neqv. .true.) call abort()
+if (same_type_as(b1,a11) .neqv. .false.) call abort()
+allocate(t1 :: b1)
+if (same_type_as(b1,a1)  .neqv. .true.) call abort()
+if (same_type_as(b1,a11) .neqv. .false.) call abort()
+deallocate(b1)
+allocate(t11 :: b1)
+if (same_type_as(b1,a1)  .neqv. .false.) call abort()
+if (same_type_as(b1,a11) .neqv. .true.) call abort()
+deallocate(b1)
+
+! .true. -> same type
+if (extends_type_of(a1,a1)   .neqv. .true.) call should_not_exist()
+if (extends_type_of(a11,a11) .neqv. .true.) call should_not_exist()
+if (extends_type_of(a2,a2)   .neqv. .true.) call should_not_exist()
+
+! .false. -> type compatibility possible
+if (extends_type_of(a1,a2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,a1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,a2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,b2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,b1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b11,b2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,b11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,a2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,a1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(b11,a2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(b2,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(a1,b2)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,b1)  .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,b2) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a2,b11) .neqv. .false.) call should_not_exist()
+
+! type extension possible, compile-time checkable
+if (extends_type_of(a1,a11) .neqv. .false.) call should_not_exist()
+if (extends_type_of(a11,a1) .neqv. .true.) call should_not_exist()
+if (extends_type_of(a1,a11) .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(b1,a1)   .neqv. .true.) call should_not_exist()
+if (extends_type_of(b11,a1)  .neqv. .true.) call should_not_exist()
+if (extends_type_of(b11,a11) .neqv. .true.) call should_not_exist()
+if (extends_type_of(b1,a11)  .neqv. .false.) call should_not_exist()
+
+if (extends_type_of(a1,b11)  .neqv. .false.) call abort()
+
+! Special case, simplified at tree folding:
+if (extends_type_of(b1,b1)   .neqv. .true.) call abort()
+
+! All other possibilities are not compile-time checkable
+if (extends_type_of(b11,b1)  .neqv. .true.) call abort()
+!if (extends_type_of(b1,b11)  .neqv. .false.) call abort() ! FAILS due to PR 47189
+if (extends_type_of(a11,b11) .neqv. .true.) call abort()
+allocate(t11 :: b11)
+if (extends_type_of(a11,b11) .neqv. .true.) call abort()
+deallocate(b11)
+allocate(t111 :: b11)
+if (extends_type_of(a11,b11) .neqv. .false.) call abort()
+deallocate(b11)
+allocate(t11 :: b1)
+if (extends_type_of(a11,b1) .neqv. .true.) call abort()
+deallocate(b1)
+
+end
+
+! { dg-final { scan-tree-dump-times "abort" 13 "original" } }
+! { dg-final { scan-tree-dump-times "should_not_exist" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }