gcc/testsuite/gfortran.dg/transpose_4.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/60392
   4 ! In the transposed case call to my_mul_cont, the compiler used to (wrongly)
   5 ! reuse a transposed descriptor for an array that was not transposed as a result
   6 ! of packing.
   7 !
   8 ! Original test case from Alexander Vogt <a.vogt@fulguritus.com>.
   9
  10 program test
  11   implicit none
  12
  13   integer, dimension(2,2) :: A, R, RT
  14   integer, dimension(2,2) :: B1, B2
  15
  16   !
  17   ! A = [  2   17 ]
  18   !     [ 82  257 ]
  19   !
  20   ! matmul(a,a) = [  1398   4403 ]
  21   !               [ 21238  67443 ]
  22   !
  23   ! matmul(transpose(a), a) = [  6728  21108 ]
  24   !                           [ 21108  66338 ]
  25   A(1,1) =   2
  26   A(1,2) =  17
  27   A(2,1) =  82
  28   A(2,2) = 257
  29
  30   R(1,1) =  1398
  31   R(1,2) =  4403
  32   R(2,1) = 21238
  33   R(2,2) = 67443
  34
  35   RT(1,1) =  6728
  36   RT(1,2) = 21108
  37   RT(2,1) = 21108
  38   RT(2,2) = 66338
  39
  40   ! Normal argument
  41   B1 = 0
  42   B2 = 0
  43   B1 = my_mul(A,A)
  44   B2 = my_mul_cont(A,A)
  45 ! print *,'Normal:    ',maxval(abs(B1-B2))
  46 ! print *,B1
  47 ! print *,B2
  48   if (any(B1 /= R)) call abort
  49   if (any(B2 /= R)) call abort
  50
  51   ! Transposed argument
  52   B1 = 0
  53   B2 = 0
  54   B1 = my_mul(transpose(A),A)
  55   B2 = my_mul_cont(transpose(A),A)
  56 ! print *,'Transposed:',maxval(abs(B1-B2))
  57 ! print *,B1
  58 ! print *,B2
  59   if (any(B1 /= RT)) call abort
  60   if (any(B2 /= RT)) call abort
  61
  62 contains
  63
  64   function my_mul(A,C) result (B)
  65     use, intrinsic :: ISO_Fortran_env
  66     integer, intent(in) :: A(2,2), C(2,2)
  67     integer :: B(2,2)
  68     B = matmul(A, C)
  69   end function
  70
  71   function my_mul_cont(A,C) result (B)
  72     use, intrinsic :: ISO_Fortran_env
  73     integer, intent(in), contiguous :: A(:,:), C(:,:)
  74     integer :: B(2,2)
  75     B = matmul(A, C)
  76   end function
  77
  78 end program