gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90

   1 ! { dg-do run }
   2 ! Tests fix for PR31193, in which the character length for MOLD in
   3 ! case 1 below was not being translated correctly for character
   4 ! constants and an ICE ensued.  The further cases are either checks
   5 ! or new bugs that were found in the course of development cases 3 & 5.
   6 !
   7 ! Contributed by Brooks Moses <brooks@gcc.gnu.org>
   8 !
   9 function NumOccurances (string, chr, isel) result(n)
  10   character(*),intent(in) :: string
  11   character(1),intent(in) :: chr
  12   integer :: isel
  13 !
  14 ! return number of occurances of character in given string
  15 !
  16     select case (isel)
  17       case (1)
  18       n=count(transfer(string, char(1), len(string))==chr)
  19       case (2)
  20       n=count(transfer(string, chr, len(string))==chr)
  21       case (3)
  22       n=count(transfer(string, "a", len(string))==chr)
  23       case (4)
  24       n=count(transfer(string, (/"a","b"/), len(string))==chr)
  25       case (5)
  26       n=count(transfer(string, string(1:1), len(string))==chr)
  27     end select
  28   return
  29 end
  30
  31   if (NumOccurances("abacadae", "a", 1) .ne. 4) call abort ()
  32   if (NumOccurances("abacadae", "a", 2) .ne. 4) call abort ()
  33   if (NumOccurances("abacadae", "a", 3) .ne. 4) call abort ()
  34   if (NumOccurances("abacadae", "a", 4) .ne. 4) call abort ()
  35   if (NumOccurances("abacadae", "a", 5) .ne. 4) call abort ()
  36 end