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

Subversion Repositories openrisc

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

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

Line No. Rev Author Line
1 149 jeremybenn
! { dg-do run }
2
! Test functions returning arrays of indeterminate size.
3
program ret_array_1
4
  integer, dimension(:, :), allocatable :: a
5
  integer, dimension(2) :: b
6
 
7
  allocate (a(2, 3))
8
  a = reshape ((/1, 2, 3, 4, 5, 6/), (/2, 3/))
9
 
10
  ! Using the return value as an actual argument
11
  b = 0;
12
  b = sum (transpose (a), 1);
13
  if (any (b .ne. (/9, 12/))) call abort ()
14
 
15
  ! Using the return value in an expression
16
  b = 0;
17
  b = sum (transpose (a) + 1, 1);
18
  if (any (b .ne. (/12, 15/))) call abort ()
19
 
20
  ! Same again testing a user function
21
! TODO: enable these once this is implemented
22
!  b = 0;
23
!  b = sum (my_transpose (a), 1);
24
!  if (any (b .ne. (/9, 12/))) call abort ()
25
!
26
!  ! Using the return value in an expression
27
!  b = 0;
28
!  b = sum (my_transpose (a) + 1, 1);
29
!  if (any (b .ne. (/12, 15/))) call abort ()
30
contains
31
subroutine test(x, n)
32
  integer, dimension (:, :) :: x
33
  integer n
34
 
35
  if (any (shape (x) .ne. (/3, 2/))) call abort
36
  if (any (x .ne. (n + reshape((/1, 4, 2, 5, 3, 6/), (/3, 2/))))) call abort
37
end subroutine
38
 
39
function my_transpose (x) result (r)
40
  interface
41
    pure function obfuscate (i)
42
      integer obfuscate
43
      integer, intent(in) :: i
44
    end function
45
  end interface
46
  integer, dimension (:, :) :: x
47
  integer, dimension (obfuscate(ubound(x, 2)), &
48
                      obfuscate(ubound(x, 1))) :: r
49
  integer i
50
 
51
  do i = 1, ubound(x, 1)
52
    r(:, i) = x(i, :)
53
  end do
54
end function
55
end program
56
 
57
pure function obfuscate (i)
58
  integer obfuscate
59
  integer, intent(in) :: i
60
 
61
  obfuscate = i
62
end function
63
 

powered by: WebSVN 2.1.0

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