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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [whole_file_23.f90] - Blame information for rev 749

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

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
!
3
! PR fortran/40873
4
!
5
! Failed to compile (segfault) with -fwhole-file.
6
! Cf. PR 40873 comment 24; test case taken from
7
! PR fortran/31867 comment 6.
8
!
9
 
10
pure integer function lensum (words, sep)
11
  character (len=*), intent(in)        :: words(:), sep
12
  lensum = (size (words)-1) * len (sep) + sum (len_trim (words))
13
end function
14
 
15
module util_mod
16
  implicit none
17
  interface
18
    pure integer function lensum (words, sep)
19
      character (len=*), intent(in)        :: words(:), sep
20
    end function
21
  end interface
22
  contains
23
  function join (words, sep) result(str)
24
! trim and concatenate a vector of character variables,
25
! inserting sep between them
26
    character (len=*), intent(in)        :: words(:), sep
27
    character (len=lensum (words, sep))  :: str
28
    integer                              :: i, nw
29
    nw  = size (words)
30
    str = ""
31
    if (nw < 1) then
32
      return
33
    else
34
      str = words(1)
35
    end if
36
    do i=2,nw
37
      str = trim (str) // sep // words(i)
38
    end do
39
  end function join
40
end module util_mod
41
!
42
program xjoin
43
  use util_mod, only: join
44
  implicit none
45
  character (len=5) :: words(2) = (/"two  ","three"/)
46
  write (*,"(1x,'words = ',a)") "'"//join (words, "&")//"'"
47
end program xjoin
48
 
49
! { 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.