Skip to content

Commit c8a5cf5

Browse files
angschangsch
committed
Fix out-of-bounds write in [ds]get40
The test driver allocates a scalar for INFO, but the test writes to 3 entries. Revise INFO allocation & propagation: * Allocate sufficient space for the two INFOs * Instead of discarding INFO computed in [ds]get40, return INFO to test driver * Fix documentation of input/output arguments [ds]get31: Fix typo in docs
1 parent ecca781 commit c8a5cf5

File tree

6 files changed

+35
-33
lines changed

6 files changed

+35
-33
lines changed

‎TESTING/EIG/dchkec.f

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -92,14 +92,14 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
9292
INTEGER KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
9393
$ KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
9494
$ LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
95-
$ NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
95+
$ NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
9696
DOUBLE PRECISION EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
9797
$ RTREXC, RTRSYL, SFMIN, RTGEXC
9898
* ..
9999
* .. Local Arrays ..
100100
INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
101-
$ NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
102-
$ NTRSNA( 3 )
101+
$ NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
102+
$ NTRSEN( 3 ), NTRSNA( 3 )
103103
DOUBLE PRECISION RTRSEN( 3 ), RTRSNA( 3 )
104104
* ..
105105
* .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
227227
9987 FORMAT( ' Routines pass computational tests if test ratio is les',
228228
$ 's than', F8.2, / / )
229229
9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N',
230-
$ 'INFO=', I8, ' KNT=', I8 )
230+
$ 'INFO=', 2I8, ' KNT=', I8 )
231231
*
232232
* End of DCHKEC
233233
*

‎TESTING/EIG/dget31.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@
6565
*>
6666
*> \param[out] NINFO
6767
*> \verbatim
68-
*> NINFO is INTEGER array, dimension (3)
68+
*> NINFO is INTEGER array, dimension (2)
6969
*> NINFO(1) = number of examples with INFO less than 0
7070
*> NINFO(2) = number of examples with INFO greater than 0
7171
*> \endverbatim

‎TESTING/EIG/dget40.f

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,7 @@
1515
* DOUBLE PRECISION RMAX
1616
* ..
1717
* .. Array Arguments ..
18-
* INTEGER NINFO( 3 )
18+
* INTEGER NINFO( 2 )
1919
*
2020
*
2121
*> \par Purpose:
@@ -53,8 +53,9 @@
5353
*>
5454
*> \param[out] NINFO
5555
*> \verbatim
56-
*> NINFO is INTEGER(3)
57-
*> Number of examples where INFO is nonzero.
56+
*> NINFO is INTEGER array, dimension (2)
57+
*> NINFO( 1 ) = DTGEXC without accumulation returned INFO nonzero
58+
*> NINFO( 2 ) = DTGEXC with accumulation returned INFO nonzero
5859
*> \endverbatim
5960
*>
6061
*> \param[out] KNT
@@ -63,9 +64,10 @@
6364
*> Total number of examples tested.
6465
*> \endverbatim
6566
*>
66-
*> \param[out] NIN
67+
*> \param[in] NIN
6768
*> \verbatim
68-
*> NINFO is INTEGER
69+
*> NIN is INTEGER
70+
*> Input logical unit number.
6971
*> \endverbatim
7072
*
7173
* Authors:
@@ -90,7 +92,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
9092
DOUBLE PRECISION RMAX
9193
* ..
9294
* .. Array Arguments ..
93-
INTEGER NINFO( 3 )
95+
INTEGER NINFO( 2 )
9496
* ..
9597
*
9698
* =====================================================================
@@ -103,7 +105,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
103105
* ..
104106
* .. Local Scalars ..
105107
INTEGER I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
106-
$ ILST2, ILSTSV, INFO1, INFO2, J, LOC, N
108+
$ ILST2, ILSTSV, J, LOC, N
107109
DOUBLE PRECISION EPS, RES
108110
* ..
109111
* .. Local Arrays ..
@@ -130,7 +132,6 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
130132
KNT = 0
131133
NINFO( 1 ) = 0
132134
NINFO( 2 ) = 0
133-
NINFO( 3 ) = 0
134135
*
135136
* Read input data until N=0
136137
*
@@ -164,7 +165,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
164165
CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
165166
CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
166167
CALL DTGEXC( .FALSE., .FALSE., N, T1, LDT, S1, LDT, Q, LDT,
167-
$ Z, LDT, IFST1, ILST1, WORK, LWORK, INFO1 )
168+
$ Z, LDT, IFST1, ILST1, WORK, LWORK, NINFO ( 1 ) )
168169
DO 40 I = 1, N
169170
DO 30 J = 1, N
170171
IF( I.EQ.J .AND. Q( I, J ).NE.ONE )
@@ -183,7 +184,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
183184
CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
184185
CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
185186
CALL DTGEXC( .TRUE., .TRUE., N, T2, LDT, S2, LDT, Q, LDT,
186-
$ Z, LDT, IFST2, ILST2, WORK, LWORK, INFO2 )
187+
$ Z, LDT, IFST2, ILST2, WORK, LWORK, NINFO ( 2 ) )
187188
*
188189
* Compare T1 with T2 and S1 with S2
189190
*
@@ -199,7 +200,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
199200
$ RES = RES + ONE / EPS
200201
IF( ILST1.NE.ILST2 )
201202
$ RES = RES + ONE / EPS
202-
IF( INFO1.NE.INFO2 )
203+
IF( NINFO( 1 ).NE.NINFO( 2 ) )
203204
$ RES = RES + ONE / EPS
204205
*
205206
* Test orthogonality of Q and Z and backward error on T2 and S2

‎TESTING/EIG/schkec.f

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -92,14 +92,14 @@ SUBROUTINE SCHKEC( THRESH, TSTERR, NIN, NOUT )
9292
INTEGER KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
9393
$ KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
9494
$ LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
95-
$ NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
95+
$ NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
9696
REAL EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
9797
$ RTREXC, RTRSYL, SFMIN, RTGEXC
9898
* ..
9999
* .. Local Arrays ..
100100
INTEGER LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
101-
$ NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
102-
$ NTRSNA( 3 )
101+
$ NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
102+
$ NTRSEN( 3 ), NTRSNA( 3 )
103103
REAL RTRSEN( 3 ), RTRSNA( 3 )
104104
* ..
105105
* .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE SCHKEC( THRESH, TSTERR, NIN, NOUT )
227227
9987 FORMAT( ' Routines pass computational tests if test ratio is les',
228228
$ 's than', F8.2, / / )
229229
9986 FORMAT( ' Error in STGEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
230-
$ 'INFO=', I8, ' KNT=', I8 )
230+
$ 'INFO=', 2I8, ' KNT=', I8 )
231231
*
232232
* End of SCHKEC
233233
*

‎TESTING/EIG/sget31.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@
6565
*>
6666
*> \param[out] NINFO
6767
*> \verbatim
68-
*> NINFO is INTEGER array, dimension (3)
68+
*> NINFO is INTEGER array, dimension (2)
6969
*> NINFO(1) = number of examples with INFO less than 0
7070
*> NINFO(2) = number of examples with INFO greater than 0
7171
*> \endverbatim

‎TESTING/EIG/sget40.f

Lines changed: 13 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -12,10 +12,10 @@
1212
*
1313
* .. Scalar Arguments ..
1414
* INTEGER KNT, LMAX, NIN
15-
* REAL RMAX
15+
* REAL RMAX
1616
* ..
1717
* .. Array Arguments ..
18-
* INTEGER NINFO( 3 )
18+
* INTEGER NINFO( 2 )
1919
*
2020
*
2121
*> \par Purpose:
@@ -53,8 +53,9 @@
5353
*>
5454
*> \param[out] NINFO
5555
*> \verbatim
56-
*> NINFO is INTEGER
57-
*> Number of examples where INFO is nonzero.
56+
*> NINFO is INTEGER array, dimension (2)
57+
*> NINFO( 1 ) = STGEXC without accumulation returned INFO nonzero
58+
*> NINFO( 2 ) = STGEXC with accumulation returned INFO nonzero
5859
*> \endverbatim
5960
*>
6061
*> \param[out] KNT
@@ -63,9 +64,10 @@
6364
*> Total number of examples tested.
6465
*> \endverbatim
6566
*>
66-
*> \param[out] NIN
67+
*> \param[in] NIN
6768
*> \verbatim
68-
*> NINFO is INTEGER
69+
*> NIN is INTEGER
70+
*> Input logical unit number.
6971
*> \endverbatim
7072
*
7173
* Authors:
@@ -90,7 +92,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
9092
REAL RMAX
9193
* ..
9294
* .. Array Arguments ..
93-
INTEGER NINFO( 3 )
95+
INTEGER NINFO( 2 )
9496
* ..
9597
*
9698
* =====================================================================
@@ -103,7 +105,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
103105
* ..
104106
* .. Local Scalars ..
105107
INTEGER I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
106-
$ ILST2, ILSTSV, INFO1, INFO2, J, LOC, N
108+
$ ILST2, ILSTSV, J, LOC, N
107109
REAL EPS, RES
108110
* ..
109111
* .. Local Arrays ..
@@ -130,7 +132,6 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
130132
KNT = 0
131133
NINFO( 1 ) = 0
132134
NINFO( 2 ) = 0
133-
NINFO( 3 ) = 0
134135
*
135136
* Read input data until N=0
136137
*
@@ -164,7 +165,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
164165
CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
165166
CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
166167
CALL STGEXC( .FALSE., .FALSE., N, T1, LDT, S1, LDT, Q, LDT,
167-
$ Z, LDT, IFST1, ILST1, WORK, LWORK, INFO1 )
168+
$ Z, LDT, IFST1, ILST1, WORK, LWORK, NINFO( 1 ) )
168169
DO 40 I = 1, N
169170
DO 30 J = 1, N
170171
IF( I.EQ.J .AND. Q( I, J ).NE.ONE )
@@ -183,7 +184,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
183184
CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
184185
CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
185186
CALL STGEXC( .TRUE., .TRUE., N, T2, LDT, S2, LDT, Q, LDT,
186-
$ Z, LDT, IFST2, ILST2, WORK, LWORK, INFO2 )
187+
$ Z, LDT, IFST2, ILST2, WORK, LWORK, NINFO( 2 ) )
187188
*
188189
* Compare T1 with T2 and S1 with S2
189190
*
@@ -199,7 +200,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
199200
$ RES = RES + ONE / EPS
200201
IF( ILST1.NE.ILST2 )
201202
$ RES = RES + ONE / EPS
202-
IF( INFO1.NE.INFO2 )
203+
IF( NINFO( 1 ).NE.NINFO( 2 ) )
203204
$ RES = RES + ONE / EPS
204205
*
205206
* Test orthogonality of Q and Z and backward error on T2 and S2

0 commit comments

Comments
 (0)