gcc/testsuite/gfortran.dg/optional_absent_3.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/35203
   4 !
   5 ! Test VALUE + OPTIONAL
   6 ! for integer/real/complex/logical which are passed by value
   7 !
   8 program main
   9   implicit none
  10   call value_test ()
  11 contains
  12   subroutine value_test (ii, rr, cc, ll, ii2, rr2, cc2, ll2)
  13     integer, optional :: ii, ii2
  14     real,    optional :: rr, rr2
  15     complex, optional :: cc, cc2
  16     logical, optional :: ll, ll2
  17     value :: ii, rr, cc, ll
  18
  19     call int_test (.false., 0)
  20     call int_test (.false., 0, ii)
  21     call int_test (.false., 0, ii2)
  22     call int_test (.true., 0, 0)
  23     call int_test (.true., 2, 2)
  24
  25     call real_test (.false., 0.0)
  26     call real_test (.false., 0.0, rr)
  27     call real_test (.false., 0.0, rr2)
  28     call real_test (.true., 0.0, 0.0)
  29     call real_test (.true., 2.0, 2.0)
  30
  31     call cmplx_test (.false., cmplx (0.0))
  32     call cmplx_test (.false., cmplx (0.0), cc)
  33     call cmplx_test (.false., cmplx (0.0), cc2)
  34     call cmplx_test (.true., cmplx (0.0), cmplx (0.0))
  35     call cmplx_test (.true., cmplx (2.0), cmplx (2.0))
  36
  37     call bool_test (.false., .false.)
  38     call bool_test (.false., .false., ll)
  39     call bool_test (.false., .false., ll2)
  40     call bool_test (.true., .false., .false.)
  41     call bool_test (.true., .true., .true.)
  42   end subroutine value_test
  43
  44   subroutine int_test (ll, val, x)
  45     logical, value :: ll
  46     integer, value :: val
  47     integer, value, optional :: x
  48     if (ll .neqv. present(x)) STOP 1
  49     if (present(x)) then
  50       if (x /= val) STOP 1
  51     endif
  52   end subroutine int_test
  53
  54   subroutine real_test (ll, val, x)
  55     logical, value :: ll
  56     real, value :: val
  57     real, value, optional :: x
  58     if (ll .neqv. present(x)) STOP 2
  59     if (present(x)) then
  60       if (x /= val) STOP 2
  61     endif
  62   end subroutine real_test
  63
  64   subroutine cmplx_test (ll, val, x)
  65     logical, value :: ll
  66     complex, value :: val
  67     complex, value, optional :: x
  68     if (ll .neqv. present(x)) STOP 3
  69     if (present(x)) then
  70       if (x /= val) STOP 3
  71     endif
  72   end subroutine cmplx_test
  73
  74   subroutine bool_test (ll, val, x)
  75     logical, value :: ll
  76     logical, value :: val
  77     logical, value, optional :: x
  78     if (ll .neqv. present(x)) STOP 4
  79     if (present(x)) then
  80       if (x .neqv. val) STOP 4
  81     endif
  82   end subroutine bool_test
  83 end program main