gcc/testsuite/gfortran.dg/optional_absent_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=f2008 " }
   3 !
   4 ! Passing a null pointer or deallocated variable to an
   5 ! optional, non-pointer, non-allocatable dummy.
   6 !
   7 program test
   8   implicit none
   9   integer, pointer :: ps => NULL(), pa(:) => NULL()
  10   integer, allocatable :: as, aa(:)
  11
  12   call scalar(ps)
  13   call scalar(as)
  14   call scalar()
  15   call scalar(NULL())
  16
  17   call assumed_size(pa)
  18   call assumed_size(aa)
  19   call assumed_size()
  20   call assumed_size(NULL(pa))
  21
  22   call assumed_shape(pa)
  23   call assumed_shape(aa)
  24   call assumed_shape()
  25   call assumed_shape(NULL())
  26
  27   call ptr_func(.true., ps)
  28   call ptr_func(.true., null())
  29   call ptr_func(.false.)
  30 contains
  31   subroutine scalar(a)
  32     integer, optional :: a
  33     if (present(a)) STOP 1
  34   end subroutine scalar
  35   subroutine assumed_size(a)
  36     integer, optional :: a(*)
  37     if (present(a)) STOP 2
  38   end subroutine assumed_size
  39   subroutine assumed_shape(a)
  40     integer, optional :: a(:)
  41     if (present(a)) STOP 3
  42   end subroutine assumed_shape
  43   subroutine ptr_func(is_psnt, a)
  44     integer, optional, pointer :: a
  45     logical :: is_psnt
  46     if (is_psnt .neqv. present(a)) STOP 4
  47   end subroutine ptr_func
  48 end program test