Skip to content

Commit 451cb53

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #4088 from martin-frbg/lapack854
Fix potential stack overflows in LAPACK EIG tests (Reference-LAPACK PR 854)
2 parents eb058c2 + 0e55702 commit 451cb53

File tree

4 files changed

+114
-22
lines changed

4 files changed

+114
-22
lines changed

‎lapack-netlib/TESTING/EIG/csyl01.f

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -120,14 +120,16 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
120120
COMPLEX RMUL
121121
* ..
122122
* .. Local Arrays ..
123-
COMPLEX A( MAXM, MAXM ), B( MAXN, MAXN ),
124-
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
125-
$ X( MAXM, MAXN ),
126-
$ DUML( MAXM ), DUMR( MAXN ),
123+
COMPLEX DUML( MAXM ), DUMR( MAXN ),
127124
$ D( MAX( MAXM, MAXN ) )
128-
REAL SWORK( LDSWORK, 54 ), DUM( MAXN ), VM( 2 )
125+
REAL DUM( MAXN ), VM( 2 )
129126
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
130127
* ..
128+
* .. Allocatable Arrays ..
129+
INTEGER AllocateStatus
130+
COMPLEX, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X
131+
REAL, DIMENSION(:,:), ALLOCATABLE :: SWORK
132+
* ..
131133
* .. External Functions ..
132134
LOGICAL SISNAN
133135
REAL SLAMCH, CLANGE
@@ -139,6 +141,20 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
139141
* .. Intrinsic Functions ..
140142
INTRINSIC ABS, REAL, MAX
141143
* ..
144+
* .. Allocate memory dynamically ..
145+
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
146+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
147+
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
148+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
149+
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
150+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
151+
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
152+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
153+
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
154+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
155+
ALLOCATE ( SWORK( LDSWORK, 54 ), STAT = AllocateStatus )
156+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
157+
* ..
142158
* .. Executable Statements ..
143159
*
144160
* Get machine parameters
@@ -286,6 +302,13 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
286302
END DO
287303
END DO
288304
END DO
305+
*
306+
DEALLOCATE (A, STAT = AllocateStatus)
307+
DEALLOCATE (B, STAT = AllocateStatus)
308+
DEALLOCATE (C, STAT = AllocateStatus)
309+
DEALLOCATE (CC, STAT = AllocateStatus)
310+
DEALLOCATE (X, STAT = AllocateStatus)
311+
DEALLOCATE (SWORK, STAT = AllocateStatus)
289312
*
290313
RETURN
291314
*

‎lapack-netlib/TESTING/EIG/dsyl01.f

Lines changed: 29 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -117,13 +117,15 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
117117
$ SCALE, SCALE3, SMLNUM, TNRM, XNRM
118118
* ..
119119
* .. Local Arrays ..
120-
DOUBLE PRECISION A( MAXM, MAXM ), B( MAXN, MAXN ),
121-
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
122-
$ X( MAXM, MAXN ),
123-
$ DUML( MAXM ), DUMR( MAXN ),
120+
DOUBLE PRECISION DUML( MAXM ), DUMR( MAXN ),
124121
$ D( MAX( MAXM, MAXN ) ), DUM( MAXN ),
125-
$ SWORK( LDSWORK, 126 ), VM( 2 )
126-
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 ), IDUM( 2 )
122+
$ VM( 2 )
123+
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
124+
* ..
125+
* .. Allocatable Arrays ..
126+
INTEGER AllocateStatus
127+
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X,
128+
$ SWORK
127129
* ..
128130
* .. External Functions ..
129131
LOGICAL DISNAN
@@ -136,6 +138,20 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
136138
* .. Intrinsic Functions ..
137139
INTRINSIC ABS, DBLE, MAX
138140
* ..
141+
* .. Allocate memory dynamically ..
142+
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
143+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
144+
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
145+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
146+
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
147+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
148+
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
149+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
150+
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
151+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
152+
ALLOCATE ( SWORK( LDSWORK, 126 ), STAT = AllocateStatus )
153+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
154+
* ..
139155
* .. Executable Statements ..
140156
*
141157
* Get machine parameters
@@ -280,6 +296,13 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
280296
END DO
281297
END DO
282298
END DO
299+
*
300+
DEALLOCATE (A, STAT = AllocateStatus)
301+
DEALLOCATE (B, STAT = AllocateStatus)
302+
DEALLOCATE (C, STAT = AllocateStatus)
303+
DEALLOCATE (CC, STAT = AllocateStatus)
304+
DEALLOCATE (X, STAT = AllocateStatus)
305+
DEALLOCATE (SWORK, STAT = AllocateStatus)
283306
*
284307
RETURN
285308
*

‎lapack-netlib/TESTING/EIG/ssyl01.f

Lines changed: 29 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -117,13 +117,15 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
117117
$ SCALE, SCALE3, SMLNUM, TNRM, XNRM
118118
* ..
119119
* .. Local Arrays ..
120-
REAL A( MAXM, MAXM ), B( MAXN, MAXN ),
121-
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
122-
$ X( MAXM, MAXN ),
123-
$ DUML( MAXM ), DUMR( MAXN ),
120+
REAL DUML( MAXM ), DUMR( MAXN ),
124121
$ D( MAX( MAXM, MAXN ) ), DUM( MAXN ),
125-
$ SWORK( LDSWORK, 54 ), VM( 2 )
126-
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 ), IDUM( 2 )
122+
$ VM( 2 )
123+
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
124+
* ..
125+
* .. Allocatable Arrays ..
126+
INTEGER AllocateStatus
127+
REAL, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X,
128+
$ SWORK
127129
* ..
128130
* .. External Functions ..
129131
LOGICAL SISNAN
@@ -136,6 +138,20 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
136138
* .. Intrinsic Functions ..
137139
INTRINSIC ABS, REAL, MAX
138140
* ..
141+
* .. Allocate memory dynamically ..
142+
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
143+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
144+
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
145+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
146+
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
147+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
148+
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
149+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
150+
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
151+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
152+
ALLOCATE ( SWORK( LDSWORK, 54 ), STAT = AllocateStatus )
153+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
154+
* ..
139155
* .. Executable Statements ..
140156
*
141157
* Get machine parameters
@@ -280,6 +296,13 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
280296
END DO
281297
END DO
282298
END DO
299+
*
300+
DEALLOCATE (A, STAT = AllocateStatus)
301+
DEALLOCATE (B, STAT = AllocateStatus)
302+
DEALLOCATE (C, STAT = AllocateStatus)
303+
DEALLOCATE (CC, STAT = AllocateStatus)
304+
DEALLOCATE (X, STAT = AllocateStatus)
305+
DEALLOCATE (SWORK, STAT = AllocateStatus)
283306
*
284307
RETURN
285308
*

‎lapack-netlib/TESTING/EIG/zsyl01.f

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -120,14 +120,16 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
120120
COMPLEX*16 RMUL
121121
* ..
122122
* .. Local Arrays ..
123-
COMPLEX*16 A( MAXM, MAXM ), B( MAXN, MAXN ),
124-
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
125-
$ X( MAXM, MAXN ),
126-
$ DUML( MAXM ), DUMR( MAXN ),
123+
COMPLEX*16 DUML( MAXM ), DUMR( MAXN ),
127124
$ D( MAX( MAXM, MAXN ) )
128-
DOUBLE PRECISION SWORK( LDSWORK, 103 ), DUM( MAXN ), VM( 2 )
125+
DOUBLE PRECISION DUM( MAXN ), VM( 2 )
129126
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
130127
* ..
128+
* .. Allocatable Arrays ..
129+
INTEGER AllocateStatus
130+
COMPLEX*16, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X
131+
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: SWORK
132+
* ..
131133
* .. External Functions ..
132134
LOGICAL DISNAN
133135
DOUBLE PRECISION DLAMCH, ZLANGE
@@ -139,6 +141,20 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
139141
* .. Intrinsic Functions ..
140142
INTRINSIC ABS, DBLE, MAX, SQRT
141143
* ..
144+
* .. Allocate memory dynamically ..
145+
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
146+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
147+
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
148+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
149+
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
150+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
151+
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
152+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
153+
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
154+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
155+
ALLOCATE ( SWORK( LDSWORK, 103 ), STAT = AllocateStatus )
156+
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
157+
* ..
142158
* .. Executable Statements ..
143159
*
144160
* Get machine parameters
@@ -286,6 +302,13 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
286302
END DO
287303
END DO
288304
END DO
305+
*
306+
DEALLOCATE (A, STAT = AllocateStatus)
307+
DEALLOCATE (B, STAT = AllocateStatus)
308+
DEALLOCATE (C, STAT = AllocateStatus)
309+
DEALLOCATE (CC, STAT = AllocateStatus)
310+
DEALLOCATE (X, STAT = AllocateStatus)
311+
DEALLOCATE (SWORK, STAT = AllocateStatus)
289312
*
290313
RETURN
291314
*

0 commit comments

Comments
 (0)