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/] [char_result_8.f90] - Blame information for rev 414

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

Line No. Rev Author Line
1 302 jeremybenn
! Related to PR 15326.  Compare functions that return string pointers with
2
! functions that return strings.
3
! { dg-do run }
4
program main
5
  implicit none
6
 
7
  character (len = 30), target :: string
8
 
9
  call test (f1 (), 30)
10
  call test (f2 (50), 50)
11
  call test (f3 (), 30)
12
  call test (f4 (70), 70)
13
 
14
  call indirect (100)
15
contains
16
  function f1 ()
17
    character (len = 30) :: f1
18
    f1 = ''
19
  end function f1
20
 
21
  function f2 (i)
22
    integer :: i
23
    character (len = i) :: f2
24
    f2 = ''
25
  end function f2
26
 
27
  function f3 ()
28
    character (len = 30), pointer :: f3
29
    f3 => string
30
  end function f3
31
 
32
  function f4 (i)
33
    integer :: i
34
    character (len = i), pointer :: f4
35
    f4 => string
36
  end function f4
37
 
38
  subroutine indirect (i)
39
    integer :: i
40
    call test (f1 (), 30)
41
    call test (f2 (i), i)
42
    call test (f3 (), 30)
43
    call test (f4 (i), i)
44
  end subroutine indirect
45
 
46
  subroutine test (string, length)
47
    character (len = *) :: string
48
    integer, intent (in) :: length
49
    if (len (string) .ne. length) call abort
50
  end subroutine test
51
end program main

powered by: WebSVN 2.1.0

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