gcc/testsuite/gfortran.dg/inline_matmul_13.f90

   1 ! { dg-do run }
   2 ! { dg-options "-ffrontend-optimize -fdump-tree-original -Wrealloc-lhs" }
   3 ! PR 66094: Check functionality for MATMUL(A, TRANSPSE(B))
   4 module x
   5 contains
   6   subroutine mm1(a,b,c)
   7     real, dimension(:,:), intent(in) :: a, b
   8     real, dimension(:,:), intent(out) :: c
   9     c = -42.
  10     c = matmul(a, transpose(b))
  11   end subroutine mm1
  12 end module x
  13
  14 program main
  15   use x
  16   implicit none
  17   integer, parameter :: n = 3, m=4, cnt=2
  18   real, dimension(n,cnt) :: a
  19   real, dimension(m,cnt) :: b
  20   real, dimension(n,m) :: c, cres
  21   real, dimension(:,:), allocatable :: calloc
  22
  23   data a / 2., -3., 5., -7., 11., -13./
  24   data b /17., -23., 29., -31., 37., -39., 41., -47./
  25   data cres / -225., 356., -396., 227., -360., 392., &
  26        -229., 364., -388., 267., -424., 456./
  27
  28   c = matmul(a,transpose(b))
  29   if (sum(c-cres)>1e-4) STOP 1
  30   call mm1 (a, b, c)
  31   if (sum(c-cres)>1e-4) STOP 2
  32
  33   ! Unallocated
  34   calloc = matmul(a,transpose(b)) ! { dg-warning "Code for reallocating the allocatable array" }
  35   if (any(shape(c) /= shape(calloc))) STOP 3
  36   if (sum(calloc-cres)>1e-4) STOP 4
  37   deallocate(calloc)
  38
  39   ! Allocated to wrong shape
  40   allocate (calloc(10,10))
  41   calloc = matmul(a,transpose(b)) ! { dg-warning "Code for reallocating the allocatable array" }
  42   if (any(shape(c) /= shape(calloc))) STOP 5
  43   if (sum(calloc-cres)>1e-4) STOP 6
  44   deallocate(calloc)
  45
  46 end program main
  47 ! { dg-final { scan-tree-dump-times "_gfortran_matmul" 1 "original" } }