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)) STOP 1
  14   b = 7
  15   b = func(.true.)
  16   if (b /= 5332) STOP 2
  17   b = 7
  18   b = func(.true.) + 1
  19   if (b /= 5333) STOP 3
  20
  21   call intout (a, .false.)
  22   if (allocated (a)) STOP 4
  23   call intout (a, .true.)
  24   if (.not.allocated (a)) STOP 5
  25   if (a /= 764) STOP 6
  26   call intout2 (a)
  27   if (allocated (a)) STOP 7
  28
  29 contains
  30
  31   function func (alloc)
  32     integer, allocatable ::  func
  33     logical :: alloc
  34     if (allocated (func)) STOP 8
  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)) STOP 9
  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