Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 175 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/class_optional_1.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/class_optional_1.f90
new file mode 100644
index 000000000..2b408dbda
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/class_optional_1.f90
@@ -0,0 +1,175 @@
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! PR fortran/50981
+! PR fortran/54618
+!
+
+  implicit none
+  type t
+   integer, allocatable :: i
+  end type t
+  type, extends (t):: t2
+   integer, allocatable :: j
+  end type t2
+
+  class(t), allocatable :: xa, xa2(:), xac[:], xa2c(:)[:]
+  class(t), pointer :: xp, xp2(:)
+
+  xp => null()
+  xp2 => null()
+
+  call suba(alloc=.false., prsnt=.false.)
+  call suba(xa, alloc=.false., prsnt=.true.)
+  if (.not. allocated (xa)) call abort ()
+  if (.not. allocated (xa%i)) call abort ()
+  if (xa%i /= 5) call abort ()
+  xa%i = -3
+  call suba(xa, alloc=.true., prsnt=.true.)
+  if (allocated (xa)) call abort ()
+
+  call suba2(alloc=.false., prsnt=.false.)
+  call suba2(xa2, alloc=.false., prsnt=.true.)
+  if (.not. allocated (xa2)) call abort ()
+  if (size (xa2) /= 1) call abort ()
+  if (.not. allocated (xa2(1)%i)) call abort ()
+  if (xa2(1)%i /= 5) call abort ()
+  xa2(1)%i = -3
+  call suba2(xa2, alloc=.true., prsnt=.true.)
+  if (allocated (xa2)) call abort ()
+
+  call subp(alloc=.false., prsnt=.false.)
+  call subp(xp, alloc=.false., prsnt=.true.)
+  if (.not. associated (xp)) call abort ()
+  if (.not. allocated (xp%i)) call abort ()
+  if (xp%i /= 5) call abort ()
+  xp%i = -3
+  call subp(xp, alloc=.true., prsnt=.true.)
+  if (associated (xp)) call abort ()
+
+  call subp2(alloc=.false., prsnt=.false.)
+  call subp2(xp2, alloc=.false., prsnt=.true.)
+  if (.not. associated (xp2)) call abort ()
+  if (size (xp2) /= 1) call abort ()
+  if (.not. allocated (xp2(1)%i)) call abort ()
+  if (xp2(1)%i /= 5) call abort ()
+  xp2(1)%i = -3
+  call subp2(xp2, alloc=.true., prsnt=.true.)
+  if (associated (xp2)) call abort ()
+
+  call subac(alloc=.false., prsnt=.false.)
+  call subac(xac, alloc=.false., prsnt=.true.)
+  if (.not. allocated (xac)) call abort ()
+  if (.not. allocated (xac%i)) call abort ()
+  if (xac%i /= 5) call abort ()
+  xac%i = -3
+  call subac(xac, alloc=.true., prsnt=.true.)
+  if (allocated (xac)) call abort ()
+
+  call suba2c(alloc=.false., prsnt=.false.)
+  call suba2c(xa2c, alloc=.false., prsnt=.true.)
+  if (.not. allocated (xa2c)) call abort ()
+  if (size (xa2c) /= 1) call abort ()
+  if (.not. allocated (xa2c(1)%i)) call abort ()
+  if (xa2c(1)%i /= 5) call abort ()
+  xa2c(1)%i = -3
+  call suba2c(xa2c, alloc=.true., prsnt=.true.)
+  if (allocated (xa2c)) call abort ()
+
+contains
+ subroutine suba2c(x, prsnt, alloc)
+   class(t), optional, allocatable :: x(:)[:]
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (prsnt) then
+     if (alloc .neqv. allocated(x)) call abort ()
+     if (.not. allocated (x)) then
+       allocate (x(1)[*])
+       x(1)%i = 5
+     else
+       if (x(1)%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine suba2c
+
+ subroutine subac(x, prsnt, alloc)
+   class(t), optional, allocatable :: x[:]
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (present (x)) then
+     if (alloc .neqv. allocated(x)) call abort ()
+     if (.not. allocated (x)) then
+       allocate (x[*])
+       x%i = 5
+     else
+       if (x%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine subac
+
+ subroutine suba2(x, prsnt, alloc)
+   class(t), optional, allocatable :: x(:)
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (prsnt) then
+     if (alloc .neqv. allocated(x)) call abort ()
+     if (.not. allocated (x)) then
+       allocate (x(1))
+       x(1)%i = 5
+     else
+       if (x(1)%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine suba2
+
+ subroutine suba(x, prsnt, alloc)
+   class(t), optional, allocatable :: x
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (present (x)) then
+     if (alloc .neqv. allocated(x)) call abort ()
+     if (.not. allocated (x)) then
+       allocate (x)
+       x%i = 5
+     else
+       if (x%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine suba
+
+ subroutine subp2(x, prsnt, alloc)
+   class(t), optional, pointer :: x(:)
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (present (x)) then
+     if (alloc .neqv. associated(x)) call abort ()
+     if (.not. associated (x)) then
+       allocate (x(1))
+       x(1)%i = 5
+     else
+       if (x(1)%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine subp2
+
+ subroutine subp(x, prsnt, alloc)
+   class(t), optional, pointer :: x
+   logical prsnt, alloc
+   if (present (x) .neqv. prsnt) call abort ()
+   if (present (x)) then
+     if (alloc .neqv. associated(x)) call abort ()
+     if (.not. associated (x)) then
+       allocate (x)
+       x%i = 5
+     else
+       if (x%i /= -3) call abort()
+       deallocate (x)
+     end if
+   end if
+ end subroutine subp
+end