gcc/testsuite/gfortran.dg/allocatable_scalar_5.f90

   1 ! { dg-do run }
   2 ! { dg-options "-Wall -pedantic" }
   3 !
   4 ! PR fortran/41872
   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   if (allocated (func (.false.))) call abort ()
  15   if (.not.allocated (func (.true.))) call abort ()
  16   b = 7
  17   b = func(.true.)
  18   if (b /= 5332) call abort ()
  19   b = 7
  20   b = func(.true.) + 1
  21   if (b /= 5333) call abort ()
  22
  23   call intout (a, .false.)
  24   if (allocated (a)) call abort ()
  25   call intout (a, .true.)
  26   if (.not.allocated (a)) call abort ()
  27   if (a /= 764) call abort ()
  28   call intout2 (a)
  29   if (allocated (a)) call abort ()
  30
  31   if (allocated (func2 ())) call abort ()
  32 contains
  33
  34   function func (alloc)
  35     integer, allocatable ::  func
  36     logical :: alloc
  37     if (allocated (func)) call abort ()
  38     if (alloc) then
  39       allocate(func)
  40       func = 5332
  41     end if
  42   end function func
  43
  44   function func2 ()
  45     integer, allocatable ::  func2
  46   end function func2
  47
  48   subroutine intout (dum, alloc)
  49     implicit none
  50     integer, allocatable,intent(out) :: dum
  51     logical :: alloc
  52     if (allocated (dum)) call abort()
  53     if (alloc) then
  54       allocate (dum)
  55       dum = 764
  56     end if
  57   end subroutine intout
  58
  59   subroutine intout2 (dum) ! { dg-warning "declared INTENT.OUT. but was not set" }
  60     integer, allocatable,intent(out) :: dum
  61   end subroutine intout2
  62 end program test