1! { dg-do run } 2! { dg-options "-ffrontend-optimize -fdump-tree-optimized -Wrealloc-lhs" } 3! PR 37131 - check basic functionality of inlined matmul, making 4! sure that the library is not called, with and without reallocation. 5 6program main 7 implicit none 8 integer, parameter :: offset = -2 9 real, dimension(3,2) :: a 10 real, dimension(2,4) :: b 11 real, dimension(3,4) :: c 12 real, dimension(3,4) :: cres 13 real, dimension(:,:), allocatable :: c_alloc 14 integer, parameter :: a1_lower_p = 1 + offset, a1_upper_p = size(a,1) + offset 15 integer, parameter :: a2_lower_p = 1 + offset, a2_upper_p = size(a,2) + offset 16 integer, parameter :: b1_lower_p = 1 + offset, b1_upper_p = size(b,1) + offset 17 integer, parameter :: b2_lower_p = 1 + offset, b2_upper_p = size(b,2) + offset 18 integer, parameter :: c1_lower_p = 1 + offset, c1_upper_p = size(c,1) + offset 19 integer, parameter :: c2_lower_p = 1 + offset, c2_upper_p = size(c,2) + offset 20 real, dimension(a1_lower_p:a1_upper_p, a2_lower_p:a2_upper_p) :: ap 21 real, dimension(b1_lower_p:b1_upper_p, b2_lower_p:b2_upper_p) :: bp 22 real, dimension(c1_lower_p:c1_upper_p, c2_lower_p:c2_upper_p) :: cp 23 real, dimension(4,8,4) :: f, fresult 24 integer :: eight = 8, two = 2 25 26 type foo 27 real :: a 28 integer :: i 29 end type foo 30 31 type(foo), dimension(3,2) :: afoo 32 type(foo), dimension(2,4) :: bfoo 33 type(foo), dimension(3,4) :: cfoo 34 35 data a / 2., -3., 5., -7., 11., -13./ 36 data b /17., -23., 29., -31., 37., -39., 41., -47./ 37 data cres /195., -304., 384., 275., -428., 548., 347., -540., 692., 411., -640., 816./ 38 data fresult / & 39 0., 0., 195., 0., 0., 17., 0., 0., 0., -23.,-304., 0., 0., 0., 0., 0., & 40 0., 0., 384., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., & 41 2., 0., 275., 0., -3., 29., 0., 0., 5., -31.,-428., 0., 0., 0., 0., 0., & 42 0., 0., 548., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., & 43 -7., 0., 347., 0., 11., 37., 0., 0., -13., -39.,-540., 0., 0., 0., 0., 0., & 44 0., 0., 692., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., & 45 0., 0., 411., 0., 0., 41., 0., 0., 0., -47.,-640., 0., 0., 0., 0., 0., & 46 0., 0., 816., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0./ 47 48 integer :: a1 = size(a,1), a2 = size(a,2) 49 integer :: b1 = size(b,1), b2 = size(b,2) 50 integer :: c1 = size(c,1), c2 = size(c,2) 51 52 integer :: a1_lower, a1_upper, a2_lower, a2_upper 53 integer :: b1_lower, b1_upper, b2_lower, b2_upper 54 integer :: c1_lower, c1_upper, c2_lower, c2_upper 55 56 a1_lower = 1 + offset ; a1_upper = a1 + offset 57 a2_lower = 1 + offset ; a2_upper = a2 + offset 58 b1_lower = 1 + offset ; b1_upper = b1 + offset 59 b2_lower = 1 + offset ; b2_upper = b2 + offset 60 c1_lower = 1 + offset ; c1_upper = c1 + offset 61 c2_lower = 1 + offset ; c2_upper = c2 + offset 62 63 c = matmul(a,b) 64 if (sum(abs(c-cres))>1e-4) STOP 1 65 66 c_alloc = matmul(a,b) ! { dg-warning "Code for reallocating the allocatable array" } 67 if (sum(abs(c_alloc-cres))>1e-4) STOP 2 68 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 3 69 deallocate(c_alloc) 70 71 allocate(c_alloc(4,4)) 72 c_alloc = matmul(a,b) ! { dg-warning "Code for reallocating the allocatable array" } 73 if (sum(abs(c_alloc-cres))>1e-4) STOP 4 74 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 5 75 deallocate(c_alloc) 76 77 allocate(c_alloc(3,3)) 78 c_alloc = matmul(a,b) ! { dg-warning "Code for reallocating the allocatable array" } 79 if (sum(abs(c_alloc-cres))>1e-4) STOP 6 80 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 7 81 82 c_alloc = 42. 83 c_alloc(:,:) = matmul(a,b) 84 if (sum(abs(c_alloc-cres))>1e-4) STOP 8 85 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 9 86 87 deallocate(c_alloc) 88 89 ap = a 90 bp = b 91 cp = matmul(ap, bp) 92 if (sum(abs(cp-cres)) > 1e-4) STOP 10 93 94 f = 0 95 f(1,1:3,2:3) = a 96 f(2,2:3,:) = b 97 c = matmul(f(1,1:3,2:3), f(2,2:3,:)) 98 if (sum(abs(c-cres))>1e-4) STOP 11 99 100 f(3,1:eight:2,:) = matmul(a, b) 101 if (sum(abs(f(3,1:eight:2,:)-cres))>1e-4) STOP 12 102 103 afoo%a = a 104 bfoo%a = b 105 cfoo%a = matmul(afoo%a, bfoo%a) 106 107 if (sum(abs(cfoo%a-cres)) > 1e-4) STOP 13 108 109 block 110 real :: aa(a1, a2), bb(b1, b2), cc(c1, c2) 111 real :: am(a1_lower:a1_upper, a2_lower:a2_upper) 112 real :: bm(b1_lower:b1_upper, b2_lower:b2_upper) 113 real :: cm(c1_lower:c1_upper, c2_lower:c2_upper) 114 115 aa = a 116 bb = b 117 am = a 118 bm = b 119 120 cc = matmul(aa,bb) 121 if (sum(cc-cres)>1e-4) STOP 14 122 c_alloc = matmul(aa,bb) ! { dg-warning "Code for reallocating the allocatable array" } 123 if (sum(abs(c_alloc-cres))>1e-4) STOP 15 124 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 16 125 c_alloc = 42. 126 deallocate(c_alloc) 127 128 allocate(c_alloc(4,4)) 129 c_alloc = matmul(aa,bb) ! { dg-warning "Code for reallocating the allocatable array" } 130 if (sum(abs(c_alloc-cres))>1e-4) STOP 17 131 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 18 132 deallocate(c_alloc) 133 134 allocate(c_alloc(3,3)) 135 c_alloc = matmul(aa,bb) ! { dg-warning "Code for reallocating the allocatable array" } 136 if (sum(abs(c_alloc-cres))>1e-4) STOP 19 137 if (any([size(c_alloc,1), size(c_alloc,2)] /= [3,4])) STOP 20 138 deallocate(c_alloc) 139 140 cm = matmul(am, bm) 141 if (sum(abs(cm-cres)) > 1e-4) STOP 21 142 143 cm = 42. 144 145 cm(:,:) = matmul(a,bm) 146 if (sum(abs(cm-cres)) > 1e-4) STOP 22 147 148 end block 149 150end program main 151 152! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "optimized" } } 153