gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/41872
   4 !
   5 !
   6 program test
   7   implicit none
   8   integer, allocatable :: a
   9   integer, allocatable :: b
  10   allocate(a)
  11   call foo(a)
  12   if(.not. allocated(a)) call abort()
  13   if (a /= 5) call abort()
  14
  15   call bar(a)
  16   if (a /= 7) call abort()
  17
  18   deallocate(a)
  19   if(allocated(a)) call abort()
  20   call check3(a)
  21   if(.not. allocated(a)) call abort()
  22   if(a /= 6874) call abort()
  23   call check4(a)
  24   if(.not. allocated(a)) call abort()
  25   if(a /= -478) call abort()
  26
  27   allocate(b)
  28   b = 7482
  29   call checkOptional(.false.,.true., 7482)
  30   if (b /= 7482) call abort()
  31   call checkOptional(.true., .true., 7482, b)
  32   if (b /= 46) call abort()
  33 contains
  34   subroutine foo(a)
  35     integer, allocatable, intent(out)  :: a
  36     if(allocated(a)) call abort()
  37     allocate(a)
  38     a = 5
  39   end subroutine foo
  40
  41   subroutine bar(a)
  42     integer, allocatable, intent(inout)  :: a
  43     if(.not. allocated(a)) call abort()
  44     if (a /= 5) call abort()
  45     a = 7
  46   end subroutine bar
  47
  48   subroutine check3(a)
  49     integer, allocatable, intent(inout)  :: a
  50     if(allocated(a)) call abort()
  51     allocate(a)
  52     a = 6874
  53   end subroutine check3
  54
  55   subroutine check4(a)
  56     integer, allocatable, intent(inout)  :: a
  57     if(.not.allocated(a)) call abort()
  58     if (a /= 6874) call abort
  59     deallocate(a)
  60     if(allocated(a)) call abort()
  61     allocate(a)
  62     if(.not.allocated(a)) call abort()
  63     a = -478
  64   end subroutine check4
  65
  66   subroutine checkOptional(prsnt, alloc, val, x)
  67     logical, intent(in) :: prsnt, alloc
  68     integer, allocatable, optional :: x
  69     integer, intent(in) :: val
  70     if (present(x) .neqv. prsnt) call abort()
  71     if (present(x)) then
  72       if (allocated(x) .neqv. alloc) call abort()
  73     end if
  74     if (present(x)) then
  75       if (allocated(x)) then
  76         if (x /= val) call abort()
  77       end if
  78     end if
  79     call checkOptional2(x)
  80     if (present(x)) then
  81       if (.not. allocated(x)) call abort()
  82       if (x /= -6784) call abort()
  83       x = 46
  84     end if
  85     call checkOptional2()
  86   end subroutine checkOptional
  87   subroutine checkOptional2(x)
  88     integer, allocatable, optional, intent(out) :: x
  89     if (present(x)) then
  90       if (allocated(x)) call abort()
  91       allocate(x)
  92       x = -6784
  93     end if
  94   end subroutine checkOptional2
  95 end program test