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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [char_length_5.f90] - Blame information for rev 868

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

Line No. Rev Author Line
1 149 jeremybenn 
! { dg-do run }
2 
! Tests the fix for PR31867, in which the interface evaluation
3 
! of the character length of 'join' (ie. the length available in
4 
! the caller) was wrong.
5 
!
6 
! Contributed by
7 
!
8 
module util_mod
9 
  implicit none
10 
contains
11 
  function join (words, sep) result(str)
12 
    character (len=*), intent(in)        :: words(:),sep
13 
    character (len = (size (words) - 1) * len_trim (sep) + &
14 
               sum (len_trim (words)))   :: str
15 
    integer                              :: i,nw
16 
    nw  = size (words)
17 
    str = ""
18 
    if (nw < 1) then
19 
      return
20 
    else
21 
      str = words(1)
22 
    end if
23 
    do i=2,nw
24 
      str = trim (str) // trim (sep) // words(i)
25 
    end do
26 
  end function join
27 
end module util_mod
28 
!
29 
program xjoin
30 
  use util_mod, only: join
31 
  implicit none
32 
  integer yy
33 
  character (len=5) :: words(5:8) = (/"two  ","three","four ","five "/), sep = "^#^"
34 
  character (len=5) :: words2(4) = (/"bat  ","ball ","goal ","stump"/), sep2 = "&"
35 
 
36 
  if (join (words, sep) .ne. "two^#^three^#^four^#^five") call abort ()
37 
  if (len (join (words, sep)) .ne. 25) call abort ()
38 
 
39 
  if (join (words(5:6), sep) .ne. "two^#^three") call abort ()
40 
  if (len (join (words(5:6), sep)) .ne. 11) call abort ()
41 
 
42 
  if (join (words(7:8), sep) .ne. "four^#^five") call abort ()
43 
  if (len (join (words(7:8), sep)) .ne. 11) call abort ()
44 
 
45 
  if (join (words(5:7:2), sep) .ne. "two^#^four") call abort ()
46 
  if (len (join (words(5:7:2), sep)) .ne. 10) call abort ()
47 
 
48 
  if (join (words(6:8:2), sep) .ne. "three^#^five") call abort ()
49 
  if (len (join (words(6:8:2), sep)) .ne. 12) call abort ()
50 
 
51 
  if (join (words2, sep2) .ne. "bat&ball&goal&stump") call abort ()
52 
  if (len (join (words2, sep2)) .ne. 19) call abort ()
53 
 
54 
  if (join (words2(1:2), sep2) .ne. "bat&ball") call abort ()
55 
  if (len (join (words2(1:2), sep2)) .ne. 8) call abort ()
56 
 
57 
  if (join (words2(2:4:2), sep2) .ne. "ball&stump") call abort ()
58 
  if (len (join (words2(2:4:2), sep2)) .ne. 10) call abort ()
59 
 
60 
end program xjoin
61 
! { dg-final { cleanup-modules "util_mod" } }

powered by: WebSVN 2.1.0

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