gcc/testsuite/gfortran.dg/intent_out_6.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/41850
   4 !
   5 module test_module
   6   implicit none
   7 contains
   8   subroutine sub2(a)
   9     implicit none
  10     real,allocatable,intent(out),optional :: a(:)
  11     if(present(a)) then
  12       if(allocated(a)) call abort()
  13       allocate(a(1))
  14       a(1) = 5
  15     end if
  16   end subroutine sub2
  17   subroutine sub1(a)
  18     implicit none
  19     real,allocatable,intent(out),optional :: a(:)
  20 !    print *,'in sub1'
  21     call sub2(a)
  22     if(present(a)) then
  23       if(a(1) /= 5) call abort()
  24     end if
  25   end subroutine sub1
  26 end module test_module
  27
  28 program test
  29   use test_module
  30   implicit none
  31   real, allocatable :: x(:)
  32   allocate(x(1))
  33   call sub1()
  34   x = 8
  35   call sub1(x)
  36   if(x(1) /= 5) call abort()
  37 end program