gcc/testsuite/gfortran.dg/missing_optional_dummy_1.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR26891, in which an optional argument, whose actual
   3 ! is a missing dummy argument would cause a segfault.
   4 !
   5 ! Contributed by Paul Thomas  <pault@gcc.gnu.org>
   6 !
   7   logical :: back =.false.
   8
   9 ! This was the case that would fail - PR case was an intrinsic call.
  10   if (scan ("A quick brown fox jumps over the lazy dog", "lazy", back) &
  11       .ne. myscan ("A quick brown fox jumps over the lazy dog", "lazy")) &
  12     call abort ()
  13
  14 ! Check that the patch works with non-intrinsic functions.
  15   if (myscan ("A quick brown fox jumps over the lazy dog", "fox", back) &
  16       .ne. thyscan ("A quick brown fox jumps over the lazy dog", "fox")) &
  17     call abort ()
  18
  19 ! Check that missing, optional character actual arguments are OK.
  20   if (scan ("A quick brown fox jumps over the lazy dog", "over", back) &
  21       .ne. thyscan ("A quick brown fox jumps over the lazy dog")) &
  22     call abort ()
  23
  24 contains
  25   integer function myscan (str, substr, back)
  26     character(*), intent(in) :: str, substr
  27     logical, optional, intent(in) :: back
  28     myscan = scan (str, substr, back)
  29   end function myscan
  30
  31   integer function thyscan (str, substr, back)
  32     character(*), intent(in) :: str
  33     character(*), optional, intent(in) :: substr
  34     logical, optional, intent(in) :: back
  35     thyscan = isscan (str, substr, back)
  36   end function thyscan
  37
  38   integer function isscan (str, substr, back)
  39     character(*), intent(in) :: str
  40     character(*), optional :: substr
  41     logical, optional, intent(in) :: back
  42     if (.not.present(substr)) then
  43       isscan = myscan (str, "over", back)
  44     else
  45       isscan = myscan (str, substr, back)
  46     end if
  47   end function isscan
  48
  49 end