gcc/testsuite/gfortran.dg/bounds_check_15.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fbounds-check" }
   3 ! Test the fix for PR42783, in which a bogus array bounds violation
   4 ! with missing optional array argument.
   5 !
   6 ! Contributed by Harald Anlauf <anlauf@gmx.de>
   7 !
   8 program gfcbug99
   9   implicit none
  10   character(len=8), parameter :: mnem_list(2) = "A"
  11
  12   call foo (mnem_list)  ! This call succeeds
  13   call foo ()           ! This call fails
  14 contains
  15   subroutine foo (mnem_list)
  16     character(len=8) ,intent(in) ,optional :: mnem_list(:)
  17
  18     integer            :: i,j
  19     character(len=256) :: ml
  20     ml = ''
  21     j = 0
  22     if (present (mnem_list)) then
  23        do i = 1, size (mnem_list)
  24           if (mnem_list(i) /= "") then
  25              j = j + 1
  26              if (j > len (ml)/8) call abort ()
  27              ml((j-1)*8+1:(j-1)*8+8) = mnem_list(i)
  28           end if
  29        end do
  30     end if
  31     if (j > 0) print *, trim (ml(1:8))
  32   end subroutine foo
  33 end program gfcbug99