Regression test for illegal modification of Y in CGEMV, SGEMV and ZGEMV observed with Apple vecLib on SGEMV and DGEMV.

Author: matcross

BLAS/TESTING/cblat2.f

@@ -479,7 +479,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  LOGICAL LCE, LCERES
  EXTERNAL LCE, LCERES
 * .. External Subroutines ..
- EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH
+ EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH, CREGR1
 * .. Intrinsic Functions ..
  INTRINSIC ABS, MAX, MIN
 * .. Scalars in Common ..
@@ -734,6 +734,34 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
 *
  120 CONTINUE
 *
+* Regression test to verify preservation of y when m zero, n nonzero.
+*
+ CALL CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY, YS )
+ IF( FULL )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+ $ INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL CGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY,
+ $ INCY )
+ ELSE IF( BANDED )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+ $ ALPHA, LDA, INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL CGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY )
+ END IF
+ NC = NC + 1
+ IF( .NOT.LCE( YS, YY, LY ) )THEN
+ WRITE( NOUT, FMT = 9998 )NARGS - 1
+ FATAL = .TRUE.
+ GO TO 130
+ END IF
+*
 * Report result.
 *
  IF( ERRMAX.LT.THRESH )THEN
@@ -3219,6 +3247,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
 *
 * End of CHKXER
 *
+ END
+ SUBROUTINE CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X,
+ $ INCX, BETA, Y, INCY, YS )
+*
+* Input initialization for regression test.
+*
+* .. Scalar Arguments ..
+ CHARACTER*1 TRANS
+ INTEGER LY, M, N, KL, KU, LDA, INCX, INCY
+ COMPLEX ALPHA, BETA
+* .. Array Arguments ..
+ COMPLEX A(LDA,*), X(*), Y(*), YS(*)
+* .. Local Scalars ..
+ INTEGER I
+* .. Intrinsic Functions ..
+ INTRINSIC CMPLX, REAL
+* .. Executable Statements ..
+ TRANS = 'T'
+ M = 0
+ N = 5
+ KL = 0
+ KU = 0
+ ALPHA = CMPLX( 1.0 )
+ LDA = MAX( 1, M )
+ INCX = 1
+ BETA = CMPLX( -0.7, -0.8 )
+ INCY = 1
+ LY = ABS( INCY )*N
+ DO 10 I = 1, LY
+ Y( I ) = CMPLX( 42.0, REAL( I ) )
+ YS( I ) = Y( I )
+ 10 CONTINUE
+ RETURN
  END
  SUBROUTINE XERBLA( SRNAME, INFO )
 *

BLAS/TESTING/sblat2.f

@@ -469,7 +469,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  LOGICAL LSE, LSERES
  EXTERNAL LSE, LSERES
 * .. External Subroutines ..
- EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH
+ EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH, SREGR1
 * .. Intrinsic Functions ..
  INTRINSIC ABS, MAX, MIN
 * .. Scalars in Common ..
@@ -724,6 +724,34 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
 *
  120 CONTINUE
 *
+* Regression test to verify preservation of y when m zero, n nonzero.
+*
+ CALL SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY, YS )
+ IF( FULL )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+ $ INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL SGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY,
+ $ INCY )
+ ELSE IF( BANDED )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+ $ ALPHA, LDA, INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL SGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY )
+ END IF
+ NC = NC + 1
+ IF( .NOT.LSE( YS, YY, LY ) )THEN
+ WRITE( NOUT, FMT = 9998 )NARGS - 1
+ FATAL = .TRUE.
+ GO TO 130
+ END IF
+*
 * Report result.
 *
  IF( ERRMAX.LT.THRESH )THEN
@@ -3116,6 +3144,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
 *
 * End of CHKXER
 *
+ END
+ SUBROUTINE SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X,
+ $ INCX, BETA, Y, INCY, YS )
+*
+* Input initialization for regression test.
+*
+* .. Scalar Arguments ..
+ CHARACTER*1 TRANS
+ INTEGER LY, M, N, KL, KU, LDA, INCX, INCY
+ REAL ALPHA, BETA
+* .. Array Arguments ..
+ REAL A(LDA,*), X(*), Y(*), YS(*)
+* .. Local Scalars ..
+ INTEGER I
+* .. Intrinsic Functions ..
+ INTRINSIC REAL
+* .. Executable Statements ..
+ TRANS = 'T'
+ M = 0
+ N = 5
+ KL = 0
+ KU = 0
+ ALPHA = 1.0
+ LDA = MAX( 1, M )
+ INCX = 1
+ BETA = -0.7
+ INCY = 1
+ LY = ABS( INCY )*N
+ DO 10 I = 1, LY
+ Y( I ) = 42.0 + REAL( I )
+ YS( I ) = Y( I )
+ 10 CONTINUE
+ RETURN
  END
  SUBROUTINE XERBLA( SRNAME, INFO )
 *

BLAS/TESTING/zblat2.f

@@ -481,7 +481,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  LOGICAL LZE, LZERES
  EXTERNAL LZE, LZERES
 * .. External Subroutines ..
- EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH
+ EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH, ZREGR1
 * .. Intrinsic Functions ..
  INTRINSIC ABS, MAX, MIN
 * .. Scalars in Common ..
@@ -736,6 +736,34 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
 *
  120 CONTINUE
 *
+* Regression test to verify preservation of y when m zero, n nonzero.
+*
+ CALL ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY, YS )
+ IF( FULL )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA,
+ $ INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL ZGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY,
+ $ INCY )
+ ELSE IF( BANDED )THEN
+ IF( TRACE )
+ $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU,
+ $ ALPHA, LDA, INCX, BETA, INCY
+ IF( REWI )
+ $ REWIND NTRA
+ CALL ZGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX,
+ $ BETA, YY, INCY )
+ END IF
+ NC = NC + 1
+ IF( .NOT.LZE( YS, YY, LY ) )THEN
+ WRITE( NOUT, FMT = 9998 )NARGS - 1
+ FATAL = .TRUE.
+ GO TO 130
+ END IF
+*
 * Report result.
 *
  IF( ERRMAX.LT.THRESH )THEN
@@ -3227,6 +3255,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
 *
 * End of CHKXER
 *
+ END
+ SUBROUTINE ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X,
+ $ INCX, BETA, Y, INCY, YS )
+*
+* Input initialization for regression test.
+*
+* .. Scalar Arguments ..
+ CHARACTER*1 TRANS
+ INTEGER LY, M, N, KL, KU, LDA, INCX, INCY
+ COMPLEX*16 ALPHA, BETA
+* .. Array Arguments ..
+ COMPLEX*16 A(LDA,*), X(*), Y(*), YS(*)
+* .. Local Scalars ..
+ INTEGER I
+* .. Intrinsic Functions ..
+ INTRINSIC DBLE, DCMPLX
+* .. Executable Statements ..
+ TRANS = 'T'
+ M = 0
+ N = 5
+ KL = 0
+ KU = 0
+ ALPHA = DCMPLX( 1.0D0 )
+ LDA = MAX( 1, M )
+ INCX = 1
+ BETA = DCMPLX( -0.7D0, -0.8D0 )
+ INCY = 1
+ LY = ABS( INCY )*N
+ DO 10 I = 1, LY
+ Y( I ) = DCMPLX( 42.0D0, DBLE( I ) )
+ YS( I ) = Y( I )
+ 10 CONTINUE
+ RETURN
  END
  SUBROUTINE XERBLA( SRNAME, INFO )
 *