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) STOP 1
  32   if (NumOccurances("abacadae", "a", 2) .ne. 4) STOP 2
  33   if (NumOccurances("abacadae", "a", 3) .ne. 4) STOP 3
  34   if (NumOccurances("abacadae", "a", 4) .ne. 4) STOP 4
  35   if (NumOccurances("abacadae", "a", 5) .ne. 4) STOP 5
  36 end