Merge pull request OpenMathLib#4757 from martin-frbg/lapack1024

Fix possible infinite loop on error in the LAPACK testsuite (Reference-LAPACK PR 1024)
mmuetzel · Jun 19, 2024 · 18063b1 · 18063b1
2 parents 33bb4b9 + 2152796
commit 18063b1
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 8 deletions.
diff --git a/lapack-netlib/TESTING/EIG/ddrvst.f b/lapack-netlib/TESTING/EIG/ddrvst.f
@@ -2772,7 +2772,7 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
                      RESULT( NTEST ) = ULPINV
                      RESULT( NTEST+1 ) = ULPINV
                      RESULT( NTEST+2 ) = ULPINV
-                     GO TO 700
+                     GO TO 1750
                   END IF
                END IF
 *
@@ -2797,13 +2797,13 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
                      RETURN
                   ELSE
                      RESULT( NTEST ) = ULPINV
-                     GO TO 700
+                     GO TO 1750
                   END IF
                END IF
 *
                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
                   RESULT( NTEST ) = ULPINV
-                  GO TO 700
+                  GO TO 1750
                END IF
 *
 *              Do test 78 (or +54)
@@ -2819,6 +2819,8 @@ SUBROUTINE DDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
      $                           MAX( UNFL, TEMP3*ULP )
 *
                CALL DLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+ 1750       CONTINUE
 *
  1720       CONTINUE
 *

diff --git a/lapack-netlib/TESTING/EIG/dlahd2.f b/lapack-netlib/TESTING/EIG/dlahd2.f
@@ -534,8 +534,8 @@ SUBROUTINE DLAHD2( IOUNIT, PATH )
      $      / ' 2: norm( I - Q'' Q )   / ( m ulp )',
      $      / ' 3: norm( I - PT PT'' )   / ( n ulp )',
      $      / ' 4: norm( Y - Q'' C )   / ( norm(Y) max(m,nrhs) ulp )' )
- 9968 FORMAT( / ' Tests performed:  See sdrvst.f' )
- 9967 FORMAT( / ' Tests performed:  See cdrvst.f' )
+ 9968 FORMAT( / ' Tests performed:  See ddrvst.f' )
+ 9967 FORMAT( / ' Tests performed:  See zdrvst.f' )
 *
 *     End of DLAHD2
 *

diff --git a/lapack-netlib/TESTING/EIG/sdrvst.f b/lapack-netlib/TESTING/EIG/sdrvst.f
@@ -2772,7 +2772,7 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
                      RESULT( NTEST ) = ULPINV
                      RESULT( NTEST+1 ) = ULPINV
                      RESULT( NTEST+2 ) = ULPINV
-                     GO TO 700
+                     GO TO 1750
                   END IF
                END IF
 *
@@ -2797,13 +2797,13 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
                      RETURN
                   ELSE
                      RESULT( NTEST ) = ULPINV
-                     GO TO 700
+                     GO TO 1750
                   END IF
                END IF
 *
                IF( M3.EQ.0 .AND. N.GT.0 ) THEN
                   RESULT( NTEST ) = ULPINV
-                  GO TO 700
+                  GO TO 1750
                END IF
 *
 *              Do test 78 (or +54)
@@ -2819,6 +2819,8 @@ SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
      $                           MAX( UNFL, TEMP3*ULP )
 *
                CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
+*
+ 1750       CONTINUE
 *
  1720       CONTINUE
 *