gcc/testsuite/gfortran.dg/allocatable_scalar_5.f90

   1 ! { dg-do run }
   2 ! { dg-options "-Wall -pedantic" }
   3 !
   4 ! PR fortran/41872; updated due to PR fortran/46484
   5 !
   6 !  More tests for allocatable scalars
   7 !
   8 program test
   9   implicit none
  10   integer, allocatable :: a
  11   integer :: b
  12
  13   if (allocated (a)) call abort ()
  14   b = 7
  15   b = func(.true.)
  16   if (b /= 5332) call abort ()
  17   b = 7
  18   b = func(.true.) + 1
  19   if (b /= 5333) call abort ()
  20
  21   call intout (a, .false.)
  22   if (allocated (a)) call abort ()
  23   call intout (a, .true.)
  24   if (.not.allocated (a)) call abort ()
  25   if (a /= 764) call abort ()
  26   call intout2 (a)
  27   if (allocated (a)) call abort ()
  28
  29 contains
  30
  31   function func (alloc)
  32     integer, allocatable ::  func
  33     logical :: alloc
  34     if (allocated (func)) call abort ()
  35     if (alloc) then
  36       allocate(func)
  37       func = 5332
  38     end if
  39   end function func
  40
  41   subroutine intout (dum, alloc)
  42     implicit none
  43     integer, allocatable,intent(out) :: dum
  44     logical :: alloc
  45     if (allocated (dum)) call abort()
  46     if (alloc) then
  47       allocate (dum)
  48       dum = 764
  49     end if
  50   end subroutine intout
  51
  52   subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
  53     integer, allocatable,intent(out) :: dum
  54   end subroutine intout2
  55 end program test