gcc/testsuite/gfortran.dg/optional_absent_6.f90

   1 ! { dg-do run }
   2 ! PR fortran/107441
   3 !
   4 ! Test VALUE + OPTIONAL for integer/real/...
   5 ! in the presence of non-optional character dummies
   6
   7 program bugdemo
   8   implicit none
   9   character :: s = 'a'
  10   integer   :: t
  11
  12   t = testoptional(s)
  13   call test2 (s)
  14   call test3 (s)
  15   call test4 (w='123',x=42)
  16
  17 contains
  18
  19   function testoptional (w, x) result(t)
  20     character, intent(in)                  :: w
  21     integer,   intent(in), value, optional :: x
  22     integer :: t
  23     print *, 'present(x) is', present(x)
  24     t = 0
  25     if (present (x)) stop 1
  26   end function testoptional
  27
  28   subroutine test2 (w, x)
  29     character, intent(in)                  :: w
  30     integer,   intent(in), value, optional :: x
  31     print*, 'present(x) is', present(x)
  32     if (present (x)) stop 2
  33   end subroutine test2
  34
  35   subroutine test3 (w, x)
  36     character, intent(in),        optional :: w
  37     integer,   intent(in), value, optional :: x
  38     print *, 'present(w) is', present(w)
  39     print *, 'present(x) is', present(x)
  40     if (.not. present (w)) stop 3
  41     if (present (x)) stop 4
  42   end subroutine test3
  43
  44   subroutine test4 (r, w, x)
  45     real,                     value, optional :: r
  46     character(*), intent(in),        optional :: w
  47     integer,                  value, optional :: x
  48     print *, 'present(r) is', present(r)
  49     print *, 'present(w) is', present(w)
  50     print *, 'present(x) is', present(x)
  51     if (present (r)) stop 5
  52     if (.not. present (w)) stop 6
  53     if (.not. present (x)) stop 7
  54     print *, 'x=', x
  55     print *, 'len(w)=', len(w)
  56     if (len(w) /= 3) stop 8
  57     if (x /= 42) stop 9
  58   end subroutine test4
  59
  60 end program bugdemo