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_2.f90] - Blame information for rev 822

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


! Like char_result_1.f90, but the string arguments are pointers.
! { dg-do run }
pure function double (string)
  character (len = *), intent (in) :: string
  character (len = len (string) * 2) :: double
  double = string // string
end function double
 
function f1 (string)
  character (len = *), pointer :: string
  character (len = len (string)) :: f1
  f1 = ''
end function f1
 
function f2 (string1, string2)
  character (len = *), pointer :: string1
  character (len = len (string1) - 20), pointer :: string2
  character (len = len (string1) + len (string2) / 2) :: f2
  f2 = ''
end function f2
 
program main
  implicit none
 
  interface
    pure function double (string)
      character (len = *), intent (in) :: string
      character (len = len (string) * 2) :: double
    end function double
    function f1 (string)
      character (len = *), pointer :: string
      character (len = len (string)) :: f1
    end function f1
    function f2 (string1, string2)
      character (len = *), pointer :: string1
      character (len = len (string1) - 20), pointer :: string2
      character (len = len (string1) + len (string2) / 2) :: f2
    end function f2
  end interface
 
  integer :: a
  character (len = 80) :: text
  character (len = 70), target :: textt
  character (len = 70), pointer :: textp
 
  a = 42
  textp => textt
 
  call test (f1 (textp), 70)
  call test (f2 (textp, textp), 95)
  call test (f3 (textp), 105)
  call test (f4 (textp), 192)
  call test (f5 (textp), 140)
  call test (f6 (textp), 29)
 
  call indirect (textp)
contains
  function f3 (string)
    integer, parameter :: l1 = 30
    character (len = *), pointer :: string
    character (len = len (string) + l1 + 5) :: f3
    f3 = ''
  end function f3
 
  function f4 (string)
    character (len = len (text) - 10), pointer :: string
    character (len = len (string) + len (text) + a) :: f4
    f4 = ''
  end function f4
 
  function f5 (string)
    character (len = *), pointer :: string
    character (len = len (double (string))) :: f5
    f5 = ''
  end function f5
 
  function f6 (string)
    character (len = *), pointer :: string
    character (len = len (string (a:))) :: f6
    f6 = ''
  end function f6
 
  subroutine indirect (textp2)
    character (len = 50), pointer :: textp2
 
    call test (f1 (textp), 70)
    call test (f2 (textp, textp), 95)
    call test (f3 (textp), 105)
    call test (f4 (textp), 192)
    call test (f5 (textp), 140)
    call test (f6 (textp), 29)
 
    call test (f1 (textp2), 50)
    call test (f2 (textp2, textp), 65)
    call test (f3 (textp2), 85)
    call test (f4 (textp2), 192)
    call test (f5 (textp2), 100)
    call test (f6 (textp2), 9)
  end subroutine indirect
 
  subroutine test (string, length)
    character (len = *) :: string
    integer, intent (in) :: length
    if (len (string) .ne. length) call abort
  end subroutine test
end program main

Line No.	Rev	Author	Line
1	149	jeremybenn	`! Like char_result_1.f90, but the string arguments are pointers.`
2			`! { dg-do run }`
3			`pure function double (string)`
4			`character (len = *), intent (in) :: string`
5			`character (len = len (string) * 2) :: double`
6			`double = string // string`
7			`end function double`
8
9			`function f1 (string)`
10			`character (len = *), pointer :: string`
11			`character (len = len (string)) :: f1`
12			`f1 = ''`
13			`end function f1`
14
15			`function f2 (string1, string2)`
16			`character (len = *), pointer :: string1`
17			`character (len = len (string1) - 20), pointer :: string2`
18			`character (len = len (string1) + len (string2) / 2) :: f2`
19			`f2 = ''`
20			`end function f2`
21
22			`program main`
23			`implicit none`
24
25			`interface`
26			`pure function double (string)`
27			`character (len = *), intent (in) :: string`
28			`character (len = len (string) * 2) :: double`
29			`end function double`
30			`function f1 (string)`
31			`character (len = *), pointer :: string`
32			`character (len = len (string)) :: f1`
33			`end function f1`
34			`function f2 (string1, string2)`
35			`character (len = *), pointer :: string1`
36			`character (len = len (string1) - 20), pointer :: string2`
37			`character (len = len (string1) + len (string2) / 2) :: f2`
38			`end function f2`
39			`end interface`
40
41			`integer :: a`
42			`character (len = 80) :: text`
43			`character (len = 70), target :: textt`
44			`character (len = 70), pointer :: textp`
45
46			`a = 42`
47			`textp => textt`
48
49			`call test (f1 (textp), 70)`
50			`call test (f2 (textp, textp), 95)`
51			`call test (f3 (textp), 105)`
52			`call test (f4 (textp), 192)`
53			`call test (f5 (textp), 140)`
54			`call test (f6 (textp), 29)`
55
56			`call indirect (textp)`
57			`contains`
58			`function f3 (string)`
59			`integer, parameter :: l1 = 30`
60			`character (len = *), pointer :: string`
61			`character (len = len (string) + l1 + 5) :: f3`
62			`f3 = ''`
63			`end function f3`
64
65			`function f4 (string)`
66			`character (len = len (text) - 10), pointer :: string`
67			`character (len = len (string) + len (text) + a) :: f4`
68			`f4 = ''`
69			`end function f4`
70
71			`function f5 (string)`
72			`character (len = *), pointer :: string`
73			`character (len = len (double (string))) :: f5`
74			`f5 = ''`
75			`end function f5`
76
77			`function f6 (string)`
78			`character (len = *), pointer :: string`
79			`character (len = len (string (a:))) :: f6`
80			`f6 = ''`
81			`end function f6`
82
83			`subroutine indirect (textp2)`
84			`character (len = 50), pointer :: textp2`
85
86			`call test (f1 (textp), 70)`
87			`call test (f2 (textp, textp), 95)`
88			`call test (f3 (textp), 105)`
89			`call test (f4 (textp), 192)`
90			`call test (f5 (textp), 140)`
91			`call test (f6 (textp), 29)`
92
93			`call test (f1 (textp2), 50)`
94			`call test (f2 (textp2, textp), 65)`
95			`call test (f3 (textp2), 85)`
96			`call test (f4 (textp2), 192)`
97			`call test (f5 (textp2), 100)`
98			`call test (f6 (textp2), 9)`
99			`end subroutine indirect`
100
101			`subroutine test (string, length)`
102			`character (len = *) :: string`
103			`integer, intent (in) :: length`
104			`if (len (string) .ne. length) call abort`
105			`end subroutine test`
106			`end program main`

Browse

Tools

Subversion Repositories openrisc

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