gcc/testsuite/gfortran.dg/ret_array_1.f90

   1 ! { 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