]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90
re PR libfortran/19106 ([4.0 only] segfault in executable for print *,sum(a,dim=2...
[thirdparty/gcc.git] / gcc / testsuite / gfortran.fortran-torture / execute / intrinsic_mmloc.f90
CommitLineData
6de9cd9a
DN
1! Program to test the MINLOC and MAXLOC intrinsics
2program testmmloc
3 implicit none
4 integer, dimension (3, 3) :: a
5 integer, dimension (3) :: b
c6abe94d 6 logical, dimension (3, 3) :: m, tr
6de9cd9a 7 integer i
50dd63a9 8 character(len=10) line
6de9cd9a
DN
9
10 a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/));
c6abe94d 11 tr = .true.
6de9cd9a
DN
12
13 b = minloc (a, 1)
14 if (b(1) .ne. 1) call abort
15 if (b(2) .ne. 2) call abort
16 if (b(3) .ne. 3) call abort
50dd63a9
TK
17 b = -1
18 write (line, 9000) minloc(a,1)
19 read (line, 9000) b
20 if (b(1) .ne. 1) call abort
21 if (b(2) .ne. 2) call abort
22 if (b(3) .ne. 3) call abort
6de9cd9a
DN
23
24 m = .true.
25 m(1, 1) = .false.
26 m(1, 2) = .false.
27 b = minloc (a, 1, m)
28 if (b(1) .ne. 2) call abort
29 if (b(2) .ne. 2) call abort
30 if (b(3) .ne. 3) call abort
c6abe94d
TK
31 b = minloc (a, 1, m .and. tr)
32 if (b(1) .ne. 2) call abort
33 if (b(2) .ne. 2) call abort
34 if (b(3) .ne. 3) call abort
50dd63a9
TK
35 b = -1
36 write (line, 9000) minloc(a, 1, m)
37 read (line, 9000) b
38 if (b(1) .ne. 2) call abort
39 if (b(2) .ne. 2) call abort
40 if (b(3) .ne. 3) call abort
6de9cd9a
DN
41
42 b(1:2) = minloc(a)
43 if (b(1) .ne. 1) call abort
44 if (b(2) .ne. 1) call abort
50dd63a9
TK
45 b = -1
46 write (line, 9000) minloc(a)
47 read (line, 9000) b
48 if (b(1) .ne. 1) call abort
49 if (b(2) .ne. 1) call abort
50 if (b(3) .ne. 0) call abort
6de9cd9a
DN
51
52 b(1:2) = minloc(a, mask=m)
53 if (b(1) .ne. 2) call abort
54 if (b(2) .ne. 1) call abort
c6abe94d
TK
55 b(1:2) = minloc(a, mask=m .and. tr)
56 if (b(1) .ne. 2) call abort
57 if (b(2) .ne. 1) call abort
50dd63a9
TK
58 b = -1
59 write (line, 9000) minloc(a, mask=m)
60 read (line, 9000) b
61 if (b(1) .ne. 2) call abort
62 if (b(2) .ne. 1) call abort
63 if (b(3) .ne. 0) call abort
6de9cd9a
DN
64
65 b = maxloc (a, 1)
66 if (b(1) .ne. 3) call abort
67 if (b(2) .ne. 3) call abort
68 if (b(3) .ne. 1) call abort
50dd63a9
TK
69 b = -1
70 write (line, 9000) maxloc(a, 1)
71 read (line, 9000) b
72 if (b(1) .ne. 3) call abort
73 if (b(2) .ne. 3) call abort
74 if (b(3) .ne. 1) call abort
6de9cd9a
DN
75
76 m = .true.
77 m(1, 2) = .false.
78 m(1, 3) = .false.
79 b = maxloc (a, 1, m)
80 if (b(1) .ne. 3) call abort
81 if (b(2) .ne. 3) call abort
82 if (b(3) .ne. 2) call abort
c6abe94d
TK
83 b = maxloc (a, 1, m .and. tr)
84 if (b(1) .ne. 3) call abort
85 if (b(2) .ne. 3) call abort
86 if (b(3) .ne. 2) call abort
50dd63a9
TK
87 b = -1
88 write (line, 9000) maxloc(a, 1, m)
89 read (line, 9000) b
90 if (b(1) .ne. 3) call abort
91 if (b(2) .ne. 3) call abort
92 if (b(3) .ne. 2) call abort
6de9cd9a
DN
93
94 b(1:2) = maxloc(a)
95 if (b(1) .ne. 1) call abort
96 if (b(2) .ne. 3) call abort
50dd63a9
TK
97 b = -1
98 write (line, 9000) maxloc(a)
99 read (line, 9000) b
100 if (b(1) .ne. 1) call abort
101 if (b(2) .ne. 3) call abort
6de9cd9a
DN
102
103 b(1:2) = maxloc(a, mask=m)
104 if (b(1) .ne. 2) call abort
105 if (b(2) .ne. 3) call abort
c6abe94d
TK
106 b(1:2) = maxloc(a, mask=m .and. tr)
107 if (b(1) .ne. 2) call abort
108 if (b(2) .ne. 3) call abort
50dd63a9
TK
109 b = -1
110 write (line, 9000) maxloc(a, mask=m)
111 read (line, 9000) b
112 if (b(1) .ne. 2) call abort
113 if (b(2) .ne. 3) call abort
114 if (b(3) .ne. 0) call abort
115
1169000 format (3I3)
6de9cd9a 117end program