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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! Related to PR 15326.  Try calling string functions whose lengths depend
2
! on a dummy procedure.
3
! { dg-do run }
4
integer pure function double (x)
5
  integer, intent (in) :: x
6
  double = x * 2
7
end function double
8
 
9
program main
10
  implicit none
11
 
12
  interface
13
    integer pure function double (x)
14
      integer, intent (in) :: x
15
    end function double
16
  end interface
17
 
18
  call test (f1 (double, 100), 200)
19
 
20
  call indirect (double)
21
contains
22
  function f1 (fn, i)
23
    integer :: i
24
    interface
25
      integer pure function fn (x)
26
        integer, intent (in) :: x
27
      end function fn
28
    end interface
29
    character (len = fn (i)) :: f1
30
    f1 = ''
31
  end function f1
32
 
33
  subroutine indirect (fn)
34
    interface
35
      integer pure function fn (x)
36
        integer, intent (in) :: x
37
      end function fn
38
    end interface
39
    call test (f1 (fn, 100), 200)
40
  end subroutine indirect
41
 
42
  subroutine test (string, length)
43
    character (len = *) :: string
44
    integer, intent (in) :: length
45
    if (len (string) .ne. length) call abort
46
  end subroutine test
47
end program main

powered by: WebSVN 2.1.0

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