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

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


! Related to PR 15326.  Try calling string functions whose lengths involve
! some sort of array calculation.
! { dg-do run }
pure elemental function double (x)
  integer, intent (in) :: x
  integer :: double
  double = x * 2
end function double
 
program main
  implicit none
 
  interface
    pure elemental function double (x)
      integer, intent (in) :: x
      integer :: double
    end function double
  end interface
 
  integer, dimension (100:104), target :: a
  integer, dimension (:), pointer :: ap
  integer :: i, lower
 
  a = (/ (i + 5, i = 0, 4) /)
  ap => a
  lower = 11
 
  call test (f1 (a), 35)
  call test (f1 (ap), 35)
  call test (f1 ((/ 5, 10, 50 /)), 65)
  call test (f1 (a (101:103)), 21)
 
  call test (f2 (a), 115)
  call test (f2 (ap), 115)
  call test (f2 ((/ 5, 10, 50 /)), 119)
  call test (f2 (a (101:103)), 116)
 
  call test (f3 (a), 60)
  call test (f3 (ap), 60)
  call test (f3 ((/ 5, 10, 50 /)), 120)
  call test (f3 (a (101:103)), 30)
 
  call test (f4 (a, 13, 1), 21)
  call test (f4 (ap, 13, 2), 14)
  call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)
  call test (f4 (a (101:103), 12, 1), 15)
contains
  function f1 (array)
    integer, dimension (10:) :: array
    character (len = sum (array)) :: f1
    f1 = ''
  end function f1
 
  function f2 (array)
    integer, dimension (10:) :: array
    character (len = array (11) + a (104) + 100) :: f2
    f2 = ''
  end function f2
 
  function f3 (array)
    integer, dimension (:) :: array
    character (len = sum (double (array (2:)))) :: f3
    f3 = ''
  end function f3
 
  function f4 (array, upper, stride)
    integer, dimension (10:) :: array
    integer :: upper, stride
    character (len = sum (array (lower:upper:stride))) :: f4
    f4 = ''
  end function f4
 
  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	302	jeremybenn	`! Related to PR 15326. Try calling string functions whose lengths involve`
2			`! some sort of array calculation.`
3			`! { dg-do run }`
4			`pure elemental function double (x)`
5			`integer, intent (in) :: x`
6			`integer :: double`
7			`double = x * 2`
8			`end function double`
9
10			`program main`
11			`implicit none`
12
13			`interface`
14			`pure elemental function double (x)`
15			`integer, intent (in) :: x`
16			`integer :: double`
17			`end function double`
18			`end interface`
19
20			`integer, dimension (100:104), target :: a`
21			`integer, dimension (:), pointer :: ap`
22			`integer :: i, lower`
23
24			`a = (/ (i + 5, i = 0, 4) /)`
25			`ap => a`
26			`lower = 11`
27
28			`call test (f1 (a), 35)`
29			`call test (f1 (ap), 35)`
30			`call test (f1 ((/ 5, 10, 50 /)), 65)`
31			`call test (f1 (a (101:103)), 21)`
32
33			`call test (f2 (a), 115)`
34			`call test (f2 (ap), 115)`
35			`call test (f2 ((/ 5, 10, 50 /)), 119)`
36			`call test (f2 (a (101:103)), 116)`
37
38			`call test (f3 (a), 60)`
39			`call test (f3 (ap), 60)`
40			`call test (f3 ((/ 5, 10, 50 /)), 120)`
41			`call test (f3 (a (101:103)), 30)`
42
43			`call test (f4 (a, 13, 1), 21)`
44			`call test (f4 (ap, 13, 2), 14)`
45			`call test (f4 ((/ 5, 10, 50 /), 12, 1), 60)`
46			`call test (f4 (a (101:103), 12, 1), 15)`
47			`contains`
48			`function f1 (array)`
49			`integer, dimension (10:) :: array`
50			`character (len = sum (array)) :: f1`
51			`f1 = ''`
52			`end function f1`
53
54			`function f2 (array)`
55			`integer, dimension (10:) :: array`
56			`character (len = array (11) + a (104) + 100) :: f2`
57			`f2 = ''`
58			`end function f2`
59
60			`function f3 (array)`
61			`integer, dimension (:) :: array`
62			`character (len = sum (double (array (2:)))) :: f3`
63			`f3 = ''`
64			`end function f3`
65
66			`function f4 (array, upper, stride)`
67			`integer, dimension (10:) :: array`
68			`integer :: upper, stride`
69			`character (len = sum (array (lower:upper:stride))) :: f4`
70			`f4 = ''`
71			`end function f4`
72
73			`subroutine test (string, length)`
74			`character (len = *) :: string`
75			`integer, intent (in) :: length`
76			`if (len (string) .ne. length) call abort`
77			`end subroutine test`
78			`end program main`

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [char_result_3.f90] - Blame information for rev 414