gcc/testsuite/gfortran.dg/zero_sized_15.f90

   1 ! { dg-do run }
   2 ! PR fortran/86277
   3 !
   4 ! Check proper detection of presence of optional array dummy arguments
   5 ! for zero-sized actual array arguments or array constructors:
   6 ! tests for CHARACTER
   7
   8 program test
   9   implicit none
  10   character(0), parameter   :: c0(0) = ""
  11   character(0), parameter   :: c1(1) = ""
  12   character(1), parameter   :: d0(0) = ""
  13   character(1), parameter   :: d1(1) = ""
  14   character(0)              :: w0(0)
  15   character(0)              :: w1(1)
  16   character(:), allocatable :: cc(:)
  17   integer                   :: k = 0, l = 0     ! Test/failure counter
  18   !
  19   allocate (character(0) :: cc(0))
  20   call a0 ()
  21   call a1 ()
  22   call a2 ()
  23   call a3 ()
  24   print *, "Total tests:", k, " failed:", l
  25 contains
  26   subroutine a0 ()
  27     print *, "Variables as actual argument"
  28     call i  (c0)
  29     call i  (c1)
  30     call i  (d0)
  31     call i  (d1)
  32     call i  (w0)
  33     call i  (w1)
  34     call i  (cc)
  35     print *, "Array section as actual argument"
  36     call i  (c1(1:0))
  37     call i  (c1(1:0)(1:0))
  38     call i  (w1(1:0))
  39     call i  (w1(1:0)(1:0))
  40     call i  (cc(1:0))
  41     call i  (cc(1:0)(1:0))
  42   end subroutine a0
  43   !
  44   subroutine a1 ()
  45     print *, "Explicit temporary as actual argument"
  46     call i ((c0))
  47     call i ((c1))
  48     call i ((d0))
  49     call i ((d1))
  50     call i ((w0))
  51     call i ((w1))
  52     call i ((cc))
  53     call i ((c1(1:0)))
  54     call i ((c1(1:0)(1:0)))
  55     call i ((w1(1:0)))
  56     call i ((w1(1:0)(1:0)))
  57     call i ((cc(1:0)))
  58     call i ((cc(1:0)(1:0)))
  59   end subroutine a1
  60   !
  61   subroutine a2 ()
  62     print *, "Array constructor as actual argument"
  63     call i ([c0])
  64     call i ([c1])
  65     call i ([d0])
  66     call i ([d1])
  67     call i ([w0])
  68     call i ([w1])
  69     call i ([cc])
  70     call i ([c0,c0])
  71     call i ([c1,c1])
  72     call i ([d0,d0])
  73     call i ([cc,cc])
  74     call i ([c1(1:0)])
  75     call i ([c1(1:0)(1:0)])
  76     call i ([w1(1:0)])
  77     call i ([w1(1:0)(1:0)])
  78     call i ([cc(1:0)])
  79     call i ([cc(1:0)(1:0)])
  80   end subroutine a2
  81   !
  82   subroutine a3 ()
  83     print *, "Array constructor with type-spec as actual argument"
  84     call i ([character(0) ::   ])
  85     call i ([character(0) :: ""])
  86     call i ([character(0) :: c0])
  87     call i ([character(0) :: c1])
  88     call i ([character(0) :: d0])
  89     call i ([character(0) :: d1])
  90     call i ([character(0) :: w0])
  91     call i ([character(0) :: w1])
  92     call i ([character(0) :: cc])
  93     call i ([character(0) :: c0,c0])
  94     call i ([character(0) :: c1,c1])
  95     call i ([character(0) :: d0,d0])
  96     call i ([character(0) :: cc,cc])
  97     call i ([character(0) :: c1(1:0)])
  98     call i ([character(0) :: c1(1:0)(1:0)])
  99     call i ([character(0) :: w1(1:0)])
 100     call i ([character(0) :: w1(1:0)(1:0)])
 101     call i ([character(0) :: cc(1:0)])
 102     call i ([character(0) :: cc(1:0)(1:0)])
 103   end subroutine a3
 104   !
 105   subroutine i(arg)
 106     character(*), optional, intent(in) :: arg(:)
 107     logical :: t
 108     t = present (arg)
 109     k = k + 1
 110     print *, 'test', k, merge ("  ok", "FAIL", t)
 111     if (.not. t) l = l + 1
 112     if (.not. t) stop k
 113   end subroutine i
 114 end program