gcc/testsuite/gfortran.dg/transpose_optimization_1.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-Warray-temporaries -fdump-tree-original -finline-matmul-limit=0" }
   3 !
   4 ! PR fortran/45648
   5 ! Non-copying descriptor transpose optimization (for function call args).
   6 !
   7 ! Contributed by Richard Sandiford <richard@codesourcery.com>
   8
   9 module foo
  10   interface
  11     subroutine ext1 (a, b)
  12       real, intent (in), dimension (:, :) :: a, b
  13     end subroutine ext1
  14     subroutine ext2 (a, b)
  15       real, intent (in), dimension (:, :) :: a
  16       real, intent (out), dimension (:, :) :: b
  17     end subroutine ext2
  18     subroutine ext3 (a, b)
  19       real, dimension (:, :) :: a, b
  20     end subroutine ext3
  21   end interface
  22 contains
  23   ! No temporary needed here.
  24   subroutine test1 (n, a, b, c)
  25     integer :: n
  26     real, dimension (n, n) :: a, b, c
  27     a = matmul (transpose (b), c)
  28   end subroutine test1
  29
  30   ! No temporary either, as we know the arguments to matmul are intent(in)
  31   subroutine test2 (n, a, b)
  32     integer :: n
  33     real, dimension (n, n) :: a, b
  34     a = matmul (transpose (b), b)
  35   end subroutine test2
  36
  37   ! No temporary needed.
  38   subroutine test3 (n, a, b, c)
  39     integer :: n
  40     real, dimension (n, n) :: a, c
  41     real, dimension (n+4, n+4) :: b
  42     a = matmul (transpose (b (2:n+1, 3:n+2)), c)
  43   end subroutine test3
  44
  45   ! A temporary is needed for the result of either the transpose or matmul.
  46   subroutine test4 (n, a, b)
  47     integer :: n
  48     real, dimension (n, n) :: a, b
  49     a = matmul (transpose (a), b)       ! { dg-warning "Creating array temporary" }
  50   end subroutine test4
  51
  52   ! The temporary is needed here since the second argument to imp1
  53   ! has unknown intent.
  54   subroutine test5 (n, a)
  55     integer :: n
  56     real, dimension (n, n) :: a
  57     call imp1 (transpose (a), a)        ! { dg-warning "Creating array temporary" }
  58   end subroutine test5
  59
  60   ! No temporaries are needed here; imp1 can't modify either argument.
  61   ! We have to pack the arguments, however.
  62   subroutine test6 (n, a, b)
  63     integer :: n
  64     real, dimension (n, n) :: a, b
  65     call imp1 (transpose (a), transpose (b))    ! { dg-warning "Creating array temporary" }
  66   end subroutine test6
  67
  68   ! No temporaries are needed here; imp1 can't modify either argument.
  69   ! We don't have to pack the arguments.
  70   subroutine test6_bis (n, a, b)
  71     integer :: n
  72     real, dimension (n, n) :: a, b
  73     call ext3 (transpose (a), transpose (b))
  74   end subroutine test6_bis
  75
  76   ! No temporary is neede here; the second argument is intent(in).
  77   subroutine test7 (n, a)
  78     integer :: n
  79     real, dimension (n, n) :: a
  80     call ext1 (transpose (a), a)
  81   end subroutine test7
  82
  83   ! The temporary is needed here though.
  84   subroutine test8 (n, a)
  85     integer :: n
  86     real, dimension (n, n) :: a
  87     call ext2 (transpose (a), a)        ! { dg-warning "Creating array temporary" }
  88   end subroutine test8
  89
  90   ! Silly, but we don't need any temporaries here.
  91   subroutine test9 (n, a)
  92     integer :: n
  93     real, dimension (n, n) :: a
  94     call ext1 (transpose (transpose (a)), a)
  95   end subroutine test9
  96
  97   ! The outer transpose needs a temporary; the inner one doesn't.
  98   subroutine test10 (n, a)
  99     integer :: n
 100     real, dimension (n, n) :: a
 101     call ext2 (transpose (transpose (a)), a)    ! { dg-warning "Creating array temporary" }
 102   end subroutine test10
 103 end module foo
 104
 105 ! { dg-final { scan-tree-dump-times "struct\[^\\n\]*atmp" 4 "original" } }