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
Reference-LAPACK · Aug 3, 2022 · ee66dfe · ee66dfe
1 parent 57b36e4
commit ee66dfe
Show file tree

Hide file tree

Showing 6 changed files with 35 additions and 33 deletions.
diff --git a/TESTING/EIG/dchkec.f b/TESTING/EIG/dchkec.f
@@ -92,14 +92,14 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
       INTEGER            KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
      $                   KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
      $                   LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
-     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
+     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
       DOUBLE PRECISION   EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
      $                   RTREXC, RTRSYL, SFMIN, RTGEXC
 *     ..
 *     .. Local Arrays ..
       INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
-     $                   NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
-     $                   NTRSNA( 3 )
+     $                   NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
+     $                   NTRSEN( 3 ), NTRSNA( 3 )
       DOUBLE PRECISION   RTRSEN( 3 ), RTRSNA( 3 )
 *     ..
 *     .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE DCHKEC( THRESH, TSTERR, NIN, NOUT )
  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
      $      's than', F8.2, / / )
  9986 FORMAT( ' Error in DTGEXC: RMAX =', D12.3, / ' LMAX = ', I8, ' N',
-     $      'INFO=', I8, ' KNT=', I8 )
+     $      'INFO=', 2I8, ' KNT=', I8 )
 *
 *     End of DCHKEC
 *

diff --git a/TESTING/EIG/dget31.f b/TESTING/EIG/dget31.f
@@ -65,7 +65,7 @@
 *>
 *> \param[out] NINFO
 *> \verbatim
-*>          NINFO is INTEGER array, dimension (3)
+*>          NINFO is INTEGER array, dimension (2)
 *>          NINFO(1) = number of examples with INFO less than 0
 *>          NINFO(2) = number of examples with INFO greater than 0
 *> \endverbatim

diff --git a/TESTING/EIG/dget40.f b/TESTING/EIG/dget40.f
@@ -15,7 +15,7 @@
 *      DOUBLE PRECISION   RMAX
 *      ..
 *       .. Array Arguments ..
-*      INTEGER            NINFO( 3 )
+*      INTEGER            NINFO( 2 )
 *
 *
 *> \par Purpose:
@@ -53,8 +53,9 @@
 *>
 *> \param[out] NINFO
 *> \verbatim
-*>          NINFO is INTEGER(3)
-*>          Number of examples where INFO is nonzero.
+*>          NINFO is INTEGER array, dimension (2)
+*>          NINFO( 1 ) = DTGEXC without accumulation returned INFO nonzero
+*>          NINFO( 2 ) = DTGEXC with accumulation returned INFO nonzero
 *> \endverbatim
 *>
 *> \param[out] KNT
@@ -63,9 +64,10 @@
 *>          Total number of examples tested.
 *> \endverbatim
 *>
-*> \param[out] NIN
+*> \param[in] NIN
 *> \verbatim
-*>          NINFO is INTEGER
+*>          NIN is INTEGER
+*>          Input logical unit number.
 *> \endverbatim
 *
 *  Authors:
@@ -90,7 +92,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
       DOUBLE PRECISION   RMAX
 *     ..
 *     .. Array Arguments ..
-      INTEGER            NINFO( 3 )
+      INTEGER            NINFO( 2 )
 *     ..
 *
 *  =====================================================================
@@ -103,7 +105,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
-     $                   ILST2, ILSTSV, INFO1, INFO2, J, LOC, N
+     $                   ILST2, ILSTSV, J, LOC, N
       DOUBLE PRECISION   EPS, RES
 *     ..
 *     .. Local Arrays ..
@@ -130,7 +132,6 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
       KNT = 0
       NINFO( 1 ) = 0
       NINFO( 2 ) = 0
-      NINFO( 3 ) = 0
 *
 *     Read input data until N=0
 *
@@ -164,7 +165,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
       CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
       CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
       CALL DTGEXC( .FALSE., .FALSE., N, T1, LDT, S1, LDT, Q, LDT,
-     $             Z, LDT, IFST1, ILST1, WORK, LWORK, INFO1 )
+     $             Z, LDT, IFST1, ILST1, WORK, LWORK, NINFO ( 1 ) )
       DO 40 I = 1, N
          DO 30 J = 1, N
             IF( I.EQ.J .AND. Q( I, J ).NE.ONE )
@@ -183,7 +184,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
       CALL DLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
       CALL DLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
       CALL DTGEXC( .TRUE., .TRUE., N, T2, LDT, S2, LDT, Q, LDT,
-     $             Z, LDT, IFST2, ILST2, WORK, LWORK, INFO2 )
+     $             Z, LDT, IFST2, ILST2, WORK, LWORK, NINFO ( 2 ) )
 *
 *     Compare T1 with T2 and S1 with S2
 *
@@ -199,7 +200,7 @@ SUBROUTINE DGET40( RMAX, LMAX, NINFO, KNT, NIN )
      $   RES = RES + ONE / EPS
       IF( ILST1.NE.ILST2 )
      $   RES = RES + ONE / EPS
-      IF( INFO1.NE.INFO2 )
+      IF( NINFO( 1 ).NE.NINFO( 2 ) )
      $   RES = RES + ONE / EPS
 *
 *     Test orthogonality of Q and Z and backward error on T2 and S2

diff --git a/TESTING/EIG/schkec.f b/TESTING/EIG/schkec.f
@@ -92,14 +92,14 @@ SUBROUTINE SCHKEC( THRESH, TSTERR, NIN, NOUT )
       INTEGER            KLAEXC, KLALN2, KLANV2, KLAQTR, KLASY2, KTREXC,
      $                   KTRSEN, KTRSNA, KTRSYL, LLAEXC, LLALN2, LLANV2,
      $                   LLAQTR, LLASY2, LTREXC, LTRSYL, NLANV2, NLAQTR,
-     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, NTGEXC, LTGEXC
+     $                   NLASY2, NTESTS, NTRSYL, KTGEXC, LTGEXC
       REAL               EPS, RLAEXC, RLALN2, RLANV2, RLAQTR, RLASY2,
      $                   RTREXC, RTRSYL, SFMIN, RTGEXC
 *     ..
 *     .. Local Arrays ..
       INTEGER            LTRSEN( 3 ), LTRSNA( 3 ), NLAEXC( 2 ),
-     $                   NLALN2( 2 ), NTREXC( 3 ), NTRSEN( 3 ),
-     $                   NTRSNA( 3 )
+     $                   NLALN2( 2 ), NTGEXC( 2 ), NTREXC( 3 ),
+     $                   NTRSEN( 3 ), NTRSNA( 3 )
       REAL               RTRSEN( 3 ), RTRSNA( 3 )
 *     ..
 *     .. External Subroutines ..
@@ -227,7 +227,7 @@ SUBROUTINE SCHKEC( THRESH, TSTERR, NIN, NOUT )
  9987 FORMAT( ' Routines pass computational tests if test ratio is les',
      $      's than', F8.2, / / )
  9986 FORMAT( ' Error in STGEXC: RMAX =', E12.3, / ' LMAX = ', I8, ' N',
-     $      'INFO=', I8, ' KNT=', I8 )
+     $      'INFO=', 2I8, ' KNT=', I8 )
 *
 *     End of SCHKEC
 *

diff --git a/TESTING/EIG/sget31.f b/TESTING/EIG/sget31.f
@@ -65,7 +65,7 @@
 *>
 *> \param[out] NINFO
 *> \verbatim
-*>          NINFO is INTEGER array, dimension (3)
+*>          NINFO is INTEGER array, dimension (2)
 *>          NINFO(1) = number of examples with INFO less than 0
 *>          NINFO(2) = number of examples with INFO greater than 0
 *> \endverbatim

diff --git a/TESTING/EIG/sget40.f b/TESTING/EIG/sget40.f
@@ -12,10 +12,10 @@
 *
 *       .. Scalar Arguments ..
 *       INTEGER            KNT, LMAX, NIN
-*       REAL   RMAX
+*       REAL               RMAX
 *       ..
 *       .. Array Arguments ..
-*       INTEGER            NINFO( 3 )
+*       INTEGER            NINFO( 2 )
 *
 *
 *> \par Purpose:
@@ -53,8 +53,9 @@
 *>
 *> \param[out] NINFO
 *> \verbatim
-*>          NINFO is INTEGER
-*>          Number of examples where INFO is nonzero.
+*>          NINFO is INTEGER array, dimension (2)
+*>          NINFO( 1 ) = STGEXC without accumulation returned INFO nonzero
+*>          NINFO( 2 ) = STGEXC with accumulation returned INFO nonzero
 *> \endverbatim
 *>
 *> \param[out] KNT
@@ -63,9 +64,10 @@
 *>          Total number of examples tested.
 *> \endverbatim
 *>
-*> \param[out] NIN
+*> \param[in] NIN
 *> \verbatim
-*>          NINFO is INTEGER
+*>          NIN is INTEGER
+*>          Input logical unit number.
 *> \endverbatim
 *
 *  Authors:
@@ -90,7 +92,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
       REAL               RMAX
 *     ..
 *     .. Array Arguments ..
-      INTEGER            NINFO( 3 )
+      INTEGER            NINFO( 2 )
 *     ..
 *
 *  =====================================================================
@@ -103,7 +105,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I, IFST, IFST1, IFST2, IFSTSV, ILST, ILST1,
-     $                   ILST2, ILSTSV, INFO1, INFO2, J, LOC, N
+     $                   ILST2, ILSTSV, J, LOC, N
       REAL               EPS, RES
 *     ..
 *     .. Local Arrays ..
@@ -130,7 +132,6 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
       KNT = 0
       NINFO( 1 ) = 0
       NINFO( 2 ) = 0
-      NINFO( 3 ) = 0
 *
 *     Read input data until N=0
 *
@@ -164,7 +165,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
       CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
       CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
       CALL STGEXC( .FALSE., .FALSE., N, T1, LDT, S1, LDT, Q, LDT,
-     $             Z, LDT, IFST1, ILST1, WORK, LWORK, INFO1 )
+     $             Z, LDT, IFST1, ILST1, WORK, LWORK, NINFO( 1 ) )
       DO 40 I = 1, N
          DO 30 J = 1, N
             IF( I.EQ.J .AND. Q( I, J ).NE.ONE )
@@ -183,7 +184,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
       CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDT )
       CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDT )
       CALL STGEXC( .TRUE., .TRUE., N, T2, LDT, S2, LDT, Q, LDT,
-     $             Z, LDT, IFST2, ILST2, WORK, LWORK, INFO2 )
+     $             Z, LDT, IFST2, ILST2, WORK, LWORK, NINFO( 2 ) )
 *
 *     Compare T1 with T2 and S1 with S2
 *
@@ -199,7 +200,7 @@ SUBROUTINE SGET40( RMAX, LMAX, NINFO, KNT, NIN )
      $   RES = RES + ONE / EPS
       IF( ILST1.NE.ILST2 )
      $   RES = RES + ONE / EPS
-      IF( INFO1.NE.INFO2 )
+      IF( NINFO( 1 ).NE.NINFO( 2 ) )
      $   RES = RES + ONE / EPS
 *
 *     Test orthogonality of Q and Z and backward error on T2 and S2