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)) STOP 1
  13   if (a /= 5) STOP 2
  14
  15   call bar(a)
  16   if (a /= 7) STOP 3
  17
  18   deallocate(a)
  19   if(allocated(a)) STOP 4
  20   call check3(a)
  21   if(.not. allocated(a)) STOP 5
  22   if(a /= 6874) STOP 6
  23   call check4(a)
  24   if(.not. allocated(a)) STOP 7
  25   if(a /= -478) STOP 8
  26
  27   allocate(b)
  28   b = 7482
  29   call checkOptional(.false.,.true., 7482)
  30   if (b /= 7482) STOP 9
  31   call checkOptional(.true., .true., 7482, b)
  32   if (b /= 46) STOP 10
  33 contains
  34   subroutine foo(a)
  35     integer, allocatable, intent(out)  :: a
  36     if(allocated(a)) STOP 11
  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)) STOP 12
  44     if (a /= 5) STOP 13
  45     a = 7
  46   end subroutine bar
  47
  48   subroutine check3(a)
  49     integer, allocatable, intent(inout)  :: a
  50     if(allocated(a)) STOP 14
  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)) STOP 15
  58     if (a /= 6874) STOP 1
  59     deallocate(a)
  60     if(allocated(a)) STOP 16
  61     allocate(a)
  62     if(.not.allocated(a)) STOP 17
  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) STOP 18
  71     if (present(x)) then
  72       if (allocated(x) .neqv. alloc) STOP 19
  73     end if
  74     if (present(x)) then
  75       if (allocated(x)) then
  76         if (x /= val) STOP 20
  77       end if
  78     end if
  79     call checkOptional2(x)
  80     if (present(x)) then
  81       if (.not. allocated(x)) STOP 21
  82       if (x /= -6784) STOP 22
  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)) STOP 23
  91       allocate(x)
  92       x = -6784
  93     end if
  94   end subroutine checkOptional2
  95 end program test