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_result_7.f90] - Blame information for rev 827

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

Line No. Rev Author Line
1 149 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
  call test (f2 (double, 70), 140)
20
 
21
  call indirect (double)
22
contains
23
  function f1 (fn, i)
24
    integer :: i
25
    interface
26
      integer pure function fn (x)
27
        integer, intent (in) :: x
28
      end function fn
29
    end interface
30
    character (len = fn (i)) :: f1
31
    f1 = ''
32
  end function f1
33
 
34
  function f2 (fn, i)
35
    integer :: i, fn
36
    character (len = fn (i)) :: f2
37
    f2 = ''
38
  end function f2
39
 
40
  subroutine indirect (fn)
41
    interface
42
      integer pure function fn (x)
43
        integer, intent (in) :: x
44
      end function fn
45
    end interface
46
    call test (f1 (fn, 100), 200)
47
    call test (f2 (fn, 70), 140)
48
  end subroutine indirect
49
 
50
  subroutine test (string, length)
51
    character (len = *) :: string
52
    integer, intent (in) :: length
53
    if (len (string) .ne. length) call abort
54
  end subroutine test
55
end program main

powered by: WebSVN 2.1.0

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