gcc/testsuite/gfortran.dg/optional_absent_11.f90

   1 ! { dg-do run }
   2 ! PR fortran/113377
   3 !
   4 ! Test that a NULL actual argument to an optional dummy is not present
   5 ! (see also F2018:15.5.2.12 on argument presence)
   6
   7 program test_null_actual_is_absent
   8   implicit none
   9   integer   :: k(4) = 1
  10   character :: c(4) = "#"
  11   call one   (k)
  12   call three (c)
  13 contains
  14   subroutine one (i)
  15     integer, intent(in)  :: i(4)
  16     integer              :: kk = 2
  17     integer, allocatable :: aa
  18     integer, pointer     :: pp => NULL()
  19     print *, "Scalar integer"
  20     call two     (kk, aa)
  21     call two     (kk, pp)
  22     call two     (kk, NULL())
  23     call two     (kk, NULL(aa))
  24     call two     (kk, NULL(pp))
  25     print *, "Elemental integer"
  26     call two     (i,  aa)
  27     call two     (i,  pp)
  28     call two     (i,  NULL())
  29     call two     (i,  NULL(aa))
  30     call two     (i,  NULL(pp))
  31     print *, "Scalar integer; value"
  32     call two_val (kk, aa)
  33     call two_val (kk, pp)
  34     call two_val (kk, NULL())
  35     call two_val (kk, NULL(aa))
  36     call two_val (kk, NULL(pp))
  37     print *, "Elemental integer; value"
  38     call two_val (i,  aa)
  39     call two_val (i,  pp)
  40     call two_val (i,  NULL())
  41     call two_val (i,  NULL(aa))
  42     call two_val (i,  NULL(pp))
  43   end
  44
  45   elemental subroutine two (i, j)
  46     integer, intent(in)           :: i
  47     integer, intent(in), optional :: j
  48     if (present (j)) error stop 11
  49   end
  50
  51   elemental subroutine two_val (i, j)
  52     integer, intent(in)           :: i
  53     integer, value,      optional :: j
  54     if (present (j)) error stop 12
  55   end
  56
  57   subroutine three (y)
  58     character, intent(in)  :: y(4)
  59     character              :: zz = "*"
  60     character, allocatable :: aa
  61     character, pointer     :: pp => NULL()
  62     print *, "Scalar character"
  63     call four     (zz, aa)
  64     call four     (zz, pp)
  65     call four     (zz, NULL())
  66     call four     (zz, NULL(aa))
  67     call four     (zz, NULL(pp))
  68     print *, "Elemental character"
  69     call four     (y,  aa)
  70     call four     (y,  pp)
  71     call four     (y,  NULL())
  72     call four     (y,  NULL(aa))
  73     call four     (y,  NULL(pp))
  74     print *, "Scalar character; value"
  75     call four_val (zz, aa)
  76     call four_val (zz, pp)
  77     call four_val (zz, NULL())
  78     call four_val (zz, NULL(aa))
  79     call four_val (zz, NULL(pp))
  80     print *, "Elemental character; value"
  81     call four_val (y,  aa)
  82     call four_val (y,  pp)
  83     call four_val (y,  NULL())
  84     call four_val (y,  NULL(aa))
  85     call four_val (y,  NULL(pp))
  86   end
  87
  88   elemental subroutine four (i, j)
  89     character, intent(in)           :: i
  90     character, intent(in), optional :: j
  91     if (present (j)) error stop 21
  92   end
  93
  94   elemental subroutine four_val (i, j)
  95     character, intent(in)           :: i
  96     character, value,      optional :: j
  97     if (present (j)) error stop 22
  98   end
  99 end