OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [transfer_array_intrinsic_3.f90] - Blame information for rev 399

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { 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 
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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.