URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [transfer_array_intrinsic_3.f90] - Rev 801
Go to most recent revision | Compare with Previous | Blame | View Log
! { dg-do run }
! Tests fix for PR31193, in which the character length for MOLD in
! case 1 below was not being translated correctly for character
! constants and an ICE ensued. The further cases are either checks
! or new bugs that were found in the course of development cases 3 & 5.
!
! Contributed by Brooks Moses <brooks@gcc.gnu.org>
!
function NumOccurances (string, chr, isel) result(n)
character(*),intent(in) :: string
character(1),intent(in) :: chr
integer :: isel
!
! return number of occurances of character in given string
!
select case (isel)
case (1)
n=count(transfer(string, char(1), len(string))==chr)
case (2)
n=count(transfer(string, chr, len(string))==chr)
case (3)
n=count(transfer(string, "a", len(string))==chr)
case (4)
n=count(transfer(string, (/"a","b"/), len(string))==chr)
case (5)
n=count(transfer(string, string(1:1), len(string))==chr)
end select
return
end
if (NumOccurances("abacadae", "a", 1) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 2) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 3) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 4) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 5) .ne. 4) call abort ()
end
Go to most recent revision | Compare with Previous | Blame | View Log