]>
Commit | Line | Data |
---|---|---|
12df8d01 PT |
1 | ! { dg-do run } |
2 | ! Check the fix for PR48462 in which the assignments involving matmul | |
3 | ! seg faulted because a was automatically freed before the assignment. | |
4 | ! | |
5 | ! Contributed by John Nedney <ortp21@gmail.com> | |
6 | ! | |
7 | program main | |
8 | implicit none | |
9 | integer, parameter :: dp = kind(0.0d0) | |
10 | real(kind=dp), allocatable :: delta(:,:) | |
11 | ||
12 | call foo | |
13 | call bar | |
14 | contains | |
15 | ! | |
16 | ! Original reduced version from comment #2 | |
17 | subroutine foo | |
18 | implicit none | |
19 | real(kind=dp), allocatable :: a(:,:) | |
20 | real(kind=dp), allocatable :: b(:,:) | |
21 | ||
22 | allocate(a(3,3)) | |
23 | allocate(b(3,3)) | |
24 | allocate(delta(3,3)) | |
25 | ||
26 | b = reshape ([1d0, 0d0, 0d0, 0d0, 1d0, 0d0, 0d0, 0d0, 1d0], [3,3]) | |
27 | a = reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3]) | |
28 | ||
29 | a = matmul( matmul( a, b ), b ) | |
30 | delta = (a - reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3]))**2 | |
31 | if (any (delta > 1d-12)) call abort | |
32 | if (any (lbound (a) .ne. [1, 1])) call abort | |
33 | end subroutine | |
34 | ! | |
35 | ! Check that all is well when the shape of 'a' changes. | |
36 | subroutine bar | |
37 | implicit none | |
38 | real(kind=dp), allocatable :: a(:,:) | |
39 | real(kind=dp), allocatable :: b(:,:) | |
40 | ||
41 | b = reshape ([1d0, 1d0, 1d0], [3,1]) | |
42 | a = reshape ([1d0, 2d0, 3d0, 4d0, 5d0, 6d0, 7d0, 8d0, 9d0], [3,3]) | |
43 | ||
44 | a = matmul( a, matmul( a, b ) ) | |
45 | ||
46 | delta = (a - reshape ([198d0, 243d0, 288d0], [3,1]))**2 | |
47 | if (any (delta > 1d-12)) call abort | |
48 | if (any (lbound (a) .ne. [1, 1])) call abort | |
49 | end subroutine | |
50 | end program main | |
51 |