From 01218ae45d40029dd19797ca9a3e822c1519c00c Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 15:05:18 +0200 Subject: [PATCH 01/13] Add missing ABS in the error metric of schkbl/dchkbl The relative-error denominator used MAX(A(I,J), AIN(I,J)) without taking absolute values. For entries where both matrices are negative, the subsequent clamp replaced the denominator with SFMIN, and the difference divided by SFMIN overflowed to Infinity in single precision (sbal.in example 11). The complex checkers already use CABS1 here. sbal now reports the same finite largest error (0.100E+01, example 5) as the other three precisions. Co-Authored-By: Claude Fable 5 --- TESTING/EIG/dchkbl.f | 2 +- TESTING/EIG/schkbl.f | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/TESTING/EIG/dchkbl.f b/TESTING/EIG/dchkbl.f index bfa4d0f62..4cf312317 100644 --- a/TESTING/EIG/dchkbl.f +++ b/TESTING/EIG/dchkbl.f @@ -133,7 +133,7 @@ * DO 50 I = 1, N DO 40 J = 1, N - TEMP = MAX( A( I, J ), AIN( I, J ) ) + TEMP = MAX( ABS( A( I, J ) ), ABS( AIN( I, J ) ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 40 CONTINUE diff --git a/TESTING/EIG/schkbl.f b/TESTING/EIG/schkbl.f index ba8356477..8a43a1dc0 100644 --- a/TESTING/EIG/schkbl.f +++ b/TESTING/EIG/schkbl.f @@ -133,7 +133,7 @@ * DO 50 I = 1, N DO 40 J = 1, N - TEMP = MAX( A( I, J ), AIN( I, J ) ) + TEMP = MAX( ABS( A( I, J ) ), ABS( AIN( I, J ) ) ) TEMP = MAX( TEMP, SFMIN ) VMAX = MAX( VMAX, ABS( A( I, J )-AIN( I, J ) ) / TEMP ) 40 CONTINUE From cf265acf5aa86fc11bad9b7f4ac5a2a79f98e825 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 15:46:28 +0200 Subject: [PATCH 02/13] CBLAS: test error exits under row-major layout The error-exit testers only exercised the option arguments (Side, Uplo, Trans, Diag) with CblasColMajor, so the diagnostics in the row-major branches of the level-3 routines were never tested. Mirror every column-major option-argument test under CblasRowMajor, add the missing row-major N/K dimension tests for the syrk/herk/syr2k/her2k/ skewsyr2k families, turn the duplicated column-major blocks in the spr/hpr sections into the intended row-major tests, and make the mislabelled gemmtr ldb "row major" tests actually use CblasRowMajor. The new tests expose wrong INFO values in the row-major branches of cgemm (TransB) and the syrk/syr2k/herk/skewsyr2k families (Uplo), and silently accepted invalid Trans values in the row-major branches of the complex herk/her2k/syrk/syr2k routines; these are fixed in the following commits. Co-Authored-By: Claude Fable 5 --- CBLAS/testing/c_c2chke.c | 12 +- CBLAS/testing/c_c3chke.c | 272 ++++++++++++++++++++++++++++++++++++++- CBLAS/testing/c_d2chke.c | 12 +- CBLAS/testing/c_d3chke.c | 231 ++++++++++++++++++++++++++++++++- CBLAS/testing/c_s2chke.c | 12 +- CBLAS/testing/c_s3chke.c | 234 ++++++++++++++++++++++++++++++++- CBLAS/testing/c_z2chke.c | 12 +- CBLAS/testing/c_z3chke.c | 272 ++++++++++++++++++++++++++++++++++++++- 8 files changed, 1017 insertions(+), 40 deletions(-) diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index cba0712a2..9636d8dac 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -825,14 +825,14 @@ void F77_c2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_chpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chpr)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index a478a0cfc..7d000b8c6 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -211,6 +211,33 @@ void F77_c3chke(char * rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -263,15 +290,19 @@ void F77_c3chke(char * rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_cgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_cgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -423,6 +454,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_cgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -614,6 +662,15 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_chemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chemm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_chemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -790,6 +847,15 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_csymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1022,6 +1088,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_ctrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ctrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1302,6 +1385,23 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_ctrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ctrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1478,6 +1578,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_cherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); @@ -1590,6 +1731,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csyrk)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_csyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1702,6 +1884,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_cher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_cher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); @@ -1846,6 +2069,47 @@ void F77_c3chke(char * rout API_SUFFIX(cblas_csyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_csyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index d6b4160f9..1d2deb32a 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -870,14 +870,14 @@ void F77_d2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_dspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dspr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index 5ef472c14..cfbf76e1a 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -209,6 +209,33 @@ void F77_d3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -261,15 +288,19 @@ void F77_d3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_dgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_dgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -421,6 +452,23 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -613,6 +661,15 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -789,6 +846,15 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dskewsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_dskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1021,6 +1087,23 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dtrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_dtrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1302,6 +1385,23 @@ void F77_d3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_dtrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1478,6 +1578,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsyrk)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1590,6 +1731,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); @@ -1733,6 +1915,47 @@ void F77_d3chke(char *rout API_SUFFIX(cblas_dskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_dskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 89940b481..6249417bf 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -870,14 +870,14 @@ void F77_s2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, INVALID_UPLO, 0, ALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_sspr)(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sspr)(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 6ca1bb8c9..f941483f0 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -210,6 +210,33 @@ void F77_s3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -262,15 +289,19 @@ void F77_s3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_sgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_sgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -422,6 +453,23 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_sgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -615,6 +663,15 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -792,6 +849,15 @@ void F77_s3chke(char *rout ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_sskewsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1025,6 +1091,23 @@ void F77_s3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_strmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1306,6 +1389,23 @@ void F77_s3chke(char *rout CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_strsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1482,6 +1582,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_ssyrk)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssyrk)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1594,6 +1736,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_ssyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_ssyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); @@ -1737,6 +1921,48 @@ void F77_s3chke(char *rout API_SUFFIX(cblas_sskewsyr2k)( CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, + 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasNoTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasLower, CblasTrans, + 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_sskewsyr2k)( CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 651c82f03..c2ae6b174 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -826,14 +826,14 @@ void F77_z2chke(char *rout cblas_info = 6; RowMajorStrg = FALSE; API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); - cblas_info = 2; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, INVALID_UPLO, 0, RALPHA, X, 1, A ); chkxer(); - cblas_info = 3; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, CblasUpper, INVALID, RALPHA, X, 1, A ); chkxer(); - cblas_info = 6; RowMajorStrg = FALSE; - API_SUFFIX(cblas_zhpr)(CblasColMajor, CblasUpper, 0, RALPHA, X, 0, A ); + cblas_info = 6; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhpr)(CblasRowMajor, CblasUpper, 0, RALPHA, X, 0, A ); chkxer(); } if (cblas_ok == TRUE) diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index d7ced2b32..1903a0ae7 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -211,6 +211,33 @@ void F77_z3chke(char *rout chkxer(); /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, INVALID_UPLO, CblasNoTrans, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, INVALID_TRANSPOSE, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, INVALID_TRANSPOSE, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -263,15 +290,19 @@ void F77_z3chke(char *rout chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 0, 2, - ALPHA, A, 1, B, 1, BETA, C, 1 ); + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasNoTrans, 2, 0, + ALPHA, A, 1, B, 1, BETA, C, 2 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasNoTrans, 0, 2, + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasNoTrans, 2, 0, + ALPHA, A, 2, B, 1, BETA, C, 2 ); + chkxer(); + cblas_info = 11; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasNoTrans, CblasTrans, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 ); chkxer(); cblas_info = 11; RowMajorStrg = TRUE; - API_SUFFIX(cblas_zgemmtr)( CblasColMajor, CblasUpper, CblasTrans, CblasTrans, 2, 0, + API_SUFFIX(cblas_zgemmtr)( CblasRowMajor, CblasUpper, CblasTrans, CblasTrans, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); @@ -423,6 +454,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zgemm)( CblasColMajor, CblasTrans, CblasTrans, 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasNoTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, INVALID_TRANSPOSE, CblasTrans, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasTrans, INVALID_TRANSPOSE, 0, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zgemm)( CblasRowMajor, CblasNoTrans, CblasNoTrans, INVALID, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -615,6 +663,15 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zhemm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhemm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zhemm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -791,6 +848,15 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsymm)( CblasColMajor, CblasRight, CblasLower, 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsymm)( CblasRowMajor, INVALID_SIDE, CblasUpper, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, INVALID_UPLO, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 4; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsymm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID, 0, ALPHA, A, 1, B, 1, BETA, C, 1 ); @@ -1023,6 +1089,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_ztrmm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ztrmm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1303,6 +1386,23 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_ztrsm)( CblasColMajor, CblasRight, CblasLower, CblasTrans, CblasNonUnit, 2, 0, ALPHA, A, 1, B, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, INVALID_SIDE, CblasUpper, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, INVALID_UPLO, CblasNoTrans, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, INVALID_TRANSPOSE, + CblasNonUnit, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, + INVALID_DIAG, 0, 0, ALPHA, A, 1, B, 1 ); + chkxer(); cblas_info = 6; RowMajorStrg = TRUE; API_SUFFIX(cblas_ztrsm)( CblasRowMajor, CblasLeft, CblasUpper, CblasNoTrans, CblasNonUnit, INVALID, 0, ALPHA, A, 1, B, 1 ); @@ -1479,6 +1579,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zherk)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, RALPHA, A, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + RALPHA, A, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zherk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, RALPHA, A, 1, RBETA, C, 2 ); @@ -1591,6 +1732,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsyrk)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsyrk)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, BETA, C, 2 ); @@ -1703,6 +1885,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zher2k)(CblasColMajor, CblasLower, CblasConjTrans, 0, INVALID, ALPHA, A, 1, B, 1, RBETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, INVALID, 0, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasLower, CblasConjTrans, 0, INVALID, + ALPHA, A, 1, B, 1, RBETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zher2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, RBETA, C, 2 ); @@ -1847,6 +2070,47 @@ void F77_z3chke(char *rout API_SUFFIX(cblas_zsyr2k)(CblasColMajor, CblasLower, CblasTrans, 0, INVALID, ALPHA, A, 1, B, 1, BETA, C, 1 ); chkxer(); + /* Row Major */ + cblas_info = 2; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, INVALID_UPLO, CblasNoTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 3; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasConjTrans, 0, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 4; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, INVALID, 0, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasNoTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); + cblas_info = 5; RowMajorStrg = TRUE; + API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasLower, CblasTrans, 0, INVALID, + ALPHA, A, 1, B, 1, BETA, C, 1 ); + chkxer(); cblas_info = 8; RowMajorStrg = TRUE; API_SUFFIX(cblas_zsyr2k)(CblasRowMajor, CblasUpper, CblasNoTrans, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 2 ); From c749e19a2f869e836cc9632ad69714f378915d7e Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Fri, 24 Jul 2026 12:00:43 +0200 Subject: [PATCH 03/13] CBLAS: correct row-major error diagnostics --- CBLAS/src/cblas_cgemm.c | 2 +- CBLAS/src/cblas_cherk.c | 2 +- CBLAS/src/cblas_csyr2k.c | 2 +- CBLAS/src/cblas_csyrk.c | 2 +- CBLAS/src/cblas_ctbmv.c | 2 +- CBLAS/src/cblas_dskewsyr2k.c | 2 +- CBLAS/src/cblas_dsyr2k.c | 2 +- CBLAS/src/cblas_dsyrk.c | 2 +- CBLAS/src/cblas_dtbmv.c | 2 +- CBLAS/src/cblas_sskewsyr2k.c | 2 +- CBLAS/src/cblas_ssyr2k.c | 2 +- CBLAS/src/cblas_ssyrk.c | 2 +- CBLAS/src/cblas_stbmv.c | 2 +- CBLAS/src/cblas_zherk.c | 2 +- CBLAS/src/cblas_zsyr2k.c | 2 +- CBLAS/src/cblas_zsyrk.c | 2 +- CBLAS/src/cblas_ztbmv.c | 2 +- 17 files changed, 17 insertions(+), 17 deletions(-) diff --git a/CBLAS/src/cblas_cgemm.c b/CBLAS/src/cblas_cgemm.c index fe4b599a1..5950ed1f8 100644 --- a/CBLAS/src/cblas_cgemm.c +++ b/CBLAS/src/cblas_cgemm.c @@ -89,7 +89,7 @@ void API_SUFFIX(cblas_cgemm)(const CBLAS_LAYOUT layout, const CBLAS_TRANSPOSE Tr else if ( TransB == CblasNoTrans ) TA='N'; else { - API_SUFFIX(cblas_xerbla)(2, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); + API_SUFFIX(cblas_xerbla)(3, "cblas_cgemm", "Illegal TransB setting, %d\n", TransB); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_cherk.c b/CBLAS/src/cblas_cherk.c index 4ac61bab2..c652e1365 100644 --- a/CBLAS/src/cblas_cherk.c +++ b/CBLAS/src/cblas_cherk.c @@ -74,7 +74,7 @@ void API_SUFFIX(cblas_cherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_cherk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_csyr2k.c b/CBLAS/src/cblas_csyr2k.c index e564a9043..23df80954 100644 --- a/CBLAS/src/cblas_csyr2k.c +++ b/CBLAS/src/cblas_csyr2k.c @@ -78,7 +78,7 @@ void API_SUFFIX(cblas_csyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_csyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_csyrk.c b/CBLAS/src/cblas_csyrk.c index 21c32d0c3..0693c3c31 100644 --- a/CBLAS/src/cblas_csyrk.c +++ b/CBLAS/src/cblas_csyrk.c @@ -76,7 +76,7 @@ void API_SUFFIX(cblas_csyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_csyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ctbmv.c b/CBLAS/src/cblas_ctbmv.c index d86697b10..697bf55e6 100644 --- a/CBLAS/src/cblas_ctbmv.c +++ b/CBLAS/src/cblas_ctbmv.c @@ -124,7 +124,7 @@ void API_SUFFIX(cblas_ctbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_ctbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_ctbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dskewsyr2k.c b/CBLAS/src/cblas_dskewsyr2k.c index 62db659f8..853e5451b 100644 --- a/CBLAS/src/cblas_dskewsyr2k.c +++ b/CBLAS/src/cblas_dskewsyr2k.c @@ -79,7 +79,7 @@ void API_SUFFIX(cblas_dskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Up else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dskewsyr2k","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dskewsyr2k","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyr2k.c b/CBLAS/src/cblas_dsyr2k.c index 85e01b271..d8921af2f 100644 --- a/CBLAS/src/cblas_dsyr2k.c +++ b/CBLAS/src/cblas_dsyr2k.c @@ -78,7 +78,7 @@ void API_SUFFIX(cblas_dsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyr2k","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dsyrk.c b/CBLAS/src/cblas_dsyrk.c index dfca58214..059e42e52 100644 --- a/CBLAS/src/cblas_dsyrk.c +++ b/CBLAS/src/cblas_dsyrk.c @@ -76,7 +76,7 @@ void API_SUFFIX(cblas_dsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_dsyrk","Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_dtbmv.c b/CBLAS/src/cblas_dtbmv.c index dea9165d9..eb4b59d7c 100644 --- a/CBLAS/src/cblas_dtbmv.c +++ b/CBLAS/src/cblas_dtbmv.c @@ -101,7 +101,7 @@ void API_SUFFIX(cblas_dtbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_dtbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_dtbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_sskewsyr2k.c b/CBLAS/src/cblas_sskewsyr2k.c index 4d0dcceab..8cf0ac3ff 100644 --- a/CBLAS/src/cblas_sskewsyr2k.c +++ b/CBLAS/src/cblas_sskewsyr2k.c @@ -80,7 +80,7 @@ void API_SUFFIX(cblas_sskewsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Up else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_sskewsyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_sskewsyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssyr2k.c b/CBLAS/src/cblas_ssyr2k.c index ca471b8fa..5b5690ba7 100644 --- a/CBLAS/src/cblas_ssyr2k.c +++ b/CBLAS/src/cblas_ssyr2k.c @@ -79,7 +79,7 @@ void API_SUFFIX(cblas_ssyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_ssyr2k", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_ssyrk.c b/CBLAS/src/cblas_ssyrk.c index bf9b98508..f9f59241c 100644 --- a/CBLAS/src/cblas_ssyrk.c +++ b/CBLAS/src/cblas_ssyrk.c @@ -77,7 +77,7 @@ void API_SUFFIX(cblas_ssyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_ssyrk", + API_SUFFIX(cblas_xerbla)(2, "cblas_ssyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; diff --git a/CBLAS/src/cblas_stbmv.c b/CBLAS/src/cblas_stbmv.c index 9005e747d..89d9bd2d9 100644 --- a/CBLAS/src/cblas_stbmv.c +++ b/CBLAS/src/cblas_stbmv.c @@ -101,7 +101,7 @@ void API_SUFFIX(cblas_stbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_stbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_stbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zherk.c b/CBLAS/src/cblas_zherk.c index 8d9ab9e3c..39f6b59eb 100644 --- a/CBLAS/src/cblas_zherk.c +++ b/CBLAS/src/cblas_zherk.c @@ -74,7 +74,7 @@ void API_SUFFIX(cblas_zherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zherk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zsyr2k.c b/CBLAS/src/cblas_zsyr2k.c index 3223229d7..ca325ff02 100644 --- a/CBLAS/src/cblas_zsyr2k.c +++ b/CBLAS/src/cblas_zsyr2k.c @@ -78,7 +78,7 @@ void API_SUFFIX(cblas_zsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsyr2k", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_zsyrk.c b/CBLAS/src/cblas_zsyrk.c index 4f5b6b325..af37f29f9 100644 --- a/CBLAS/src/cblas_zsyrk.c +++ b/CBLAS/src/cblas_zsyrk.c @@ -76,7 +76,7 @@ void API_SUFFIX(cblas_zsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if ( Uplo == CblasLower ) UL='U'; else { - API_SUFFIX(cblas_xerbla)(3, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(2, "cblas_zsyrk", "Illegal Uplo setting, %d\n", Uplo); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; diff --git a/CBLAS/src/cblas_ztbmv.c b/CBLAS/src/cblas_ztbmv.c index 3b6f17e23..af86f6062 100644 --- a/CBLAS/src/cblas_ztbmv.c +++ b/CBLAS/src/cblas_ztbmv.c @@ -124,7 +124,7 @@ void API_SUFFIX(cblas_ztbmv)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, else if (Diag == CblasNonUnit) DI = 'N'; else { - API_SUFFIX(cblas_xerbla)(4, "cblas_ztbmv","Illegal Uplo setting, %d\n", Uplo); + API_SUFFIX(cblas_xerbla)(4, "cblas_ztbmv","Illegal Diag setting, %d\n", Diag); CBLAS_CallFromC = 0; RowMajorStrg = 0; return; From f754f09454b884b64834d3a6e6513166b593315e Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 15:46:52 +0200 Subject: [PATCH 04/13] CBLAS: reject invalid Trans values in row-major complex rank-k updates The row-major branches of cherk/zherk and cher2k/zher2k mapped the invalid CblasTrans to 'N', and those of csyrk/zsyrk and csyr2k/zsyr2k mapped the invalid CblasConjTrans to 'N', silently computing a different operation instead of rejecting the argument. The column-major branches forward these values to the Fortran routine, which reports them as an illegal second argument (parameter 3 of the CBLAS call). Drop the bogus mappings so the invalid values reach the row-major branches' existing error exits, which also report parameter 3. Co-Authored-By: Claude Fable 5 --- CBLAS/src/cblas_cher2k.c | 3 +-- CBLAS/src/cblas_cherk.c | 3 +-- CBLAS/src/cblas_csyr2k.c | 1 - CBLAS/src/cblas_csyrk.c | 1 - CBLAS/src/cblas_zher2k.c | 3 +-- CBLAS/src/cblas_zherk.c | 3 +-- CBLAS/src/cblas_zsyr2k.c | 1 - CBLAS/src/cblas_zsyrk.c | 1 - 8 files changed, 4 insertions(+), 12 deletions(-) diff --git a/CBLAS/src/cblas_cher2k.c b/CBLAS/src/cblas_cher2k.c index a4e24abfa..374e47a8e 100644 --- a/CBLAS/src/cblas_cher2k.c +++ b/CBLAS/src/cblas_cher2k.c @@ -85,8 +85,7 @@ void API_SUFFIX(cblas_cher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_cherk.c b/CBLAS/src/cblas_cherk.c index c652e1365..0d50a37e5 100644 --- a/CBLAS/src/cblas_cherk.c +++ b/CBLAS/src/cblas_cherk.c @@ -79,8 +79,7 @@ void API_SUFFIX(cblas_cherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_csyr2k.c b/CBLAS/src/cblas_csyr2k.c index 23df80954..62c8cd033 100644 --- a/CBLAS/src/cblas_csyr2k.c +++ b/CBLAS/src/cblas_csyr2k.c @@ -84,7 +84,6 @@ void API_SUFFIX(cblas_csyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_csyrk.c b/CBLAS/src/cblas_csyrk.c index 0693c3c31..f87383ddd 100644 --- a/CBLAS/src/cblas_csyrk.c +++ b/CBLAS/src/cblas_csyrk.c @@ -82,7 +82,6 @@ void API_SUFFIX(cblas_csyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_zher2k.c b/CBLAS/src/cblas_zher2k.c index 31a82974c..e1ac2c64d 100644 --- a/CBLAS/src/cblas_zher2k.c +++ b/CBLAS/src/cblas_zher2k.c @@ -85,8 +85,7 @@ void API_SUFFIX(cblas_zher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_zherk.c b/CBLAS/src/cblas_zherk.c index 39f6b59eb..9016a512a 100644 --- a/CBLAS/src/cblas_zherk.c +++ b/CBLAS/src/cblas_zherk.c @@ -79,8 +79,7 @@ void API_SUFFIX(cblas_zherk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, RowMajorStrg = 0; return; } - if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; + if( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='C'; else { diff --git a/CBLAS/src/cblas_zsyr2k.c b/CBLAS/src/cblas_zsyr2k.c index ca325ff02..3d09e3297 100644 --- a/CBLAS/src/cblas_zsyr2k.c +++ b/CBLAS/src/cblas_zsyr2k.c @@ -84,7 +84,6 @@ void API_SUFFIX(cblas_zsyr2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { diff --git a/CBLAS/src/cblas_zsyrk.c b/CBLAS/src/cblas_zsyrk.c index af37f29f9..885158293 100644 --- a/CBLAS/src/cblas_zsyrk.c +++ b/CBLAS/src/cblas_zsyrk.c @@ -82,7 +82,6 @@ void API_SUFFIX(cblas_zsyrk)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo, return; } if( Trans == CblasTrans) TR ='N'; - else if ( Trans == CblasConjTrans ) TR='N'; else if ( Trans == CblasNoTrans ) TR='T'; else { From 58cff20b272eb45ef4b1ececd772169e81ed2ecd Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:35:08 +0200 Subject: [PATCH 05/13] CBLAS: add CBLAS_WEAK_SYMBOL and use it for the xerbla declarations Replace the repeated void #ifdef HAS_ATTRIBUTE_WEAK_SUPPORT __attribute__((weak)) #endif preamble on the cblas_xerbla(), cblas_xerbla_64() and F77_xerbla_base() declarations with a single CBLAS_WEAK_SYMBOL macro. Define it in cblas.h ahead of the cblas_64.h include: cblas_64.h declares cblas_xerbla_64() with the macro, and its own include of cblas.h is a no-op while cblas.h is still inside its own include guard. Co-Authored-By: Claude Opus 5 (1M context) --- CBLAS/include/cblas.h | 22 +++++++++++++++++----- CBLAS/include/cblas_64.h | 7 ++----- CBLAS/include/cblas_f77.h | 17 ++++++++++++----- 3 files changed, 31 insertions(+), 15 deletions(-) diff --git a/CBLAS/include/cblas.h b/CBLAS/include/cblas.h index 2013d3028..d840bc944 100644 --- a/CBLAS/include/cblas.h +++ b/CBLAS/include/cblas.h @@ -44,6 +44,21 @@ typedef enum CBLAS_SIDE {CblasLeft=141, CblasRight=142} CBLAS_SIDE; #define CBLAS_ORDER CBLAS_LAYOUT /* this for backward compatibility with CBLAS_ORDER */ +/* + * Weak symbol support for cblas_xerbla() and F77_xerbla() + * + * Must precede the cblas_64.h include below: that header declares + * cblas_xerbla_64() with CBLAS_WEAK_SYMBOL, and its own include of cblas.h is + * a no-op while we are still inside this header's include guard. + */ +#ifndef CBLAS_WEAK_SYMBOL +#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT + #define CBLAS_WEAK_SYMBOL __attribute__((weak)) +#else + #define CBLAS_WEAK_SYMBOL +#endif +#endif + /* * Integer specific API */ @@ -684,11 +699,8 @@ void cblas_zher2k(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const void *B, const CBLAS_INT ldb, const double beta, void *C, const CBLAS_INT ldc); -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -cblas_xerbla(CBLAS_INT p, const char *rout, const char *form, ...); +void CBLAS_WEAK_SYMBOL cblas_xerbla(CBLAS_INT p, const char *rout, + const char *form, ...); #ifdef __cplusplus } diff --git a/CBLAS/include/cblas_64.h b/CBLAS/include/cblas_64.h index 064ca447a..32009bd2d 100644 --- a/CBLAS/include/cblas_64.h +++ b/CBLAS/include/cblas_64.h @@ -639,11 +639,8 @@ void cblas_zher2k_64(CBLAS_LAYOUT layout, CBLAS_UPLO Uplo, const void *B, const int64_t ldb, const double beta, void *C, const int64_t ldc); -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -cblas_xerbla_64(int64_t p, const char *rout, const char *form, ...); +void CBLAS_WEAK_SYMBOL cblas_xerbla_64(int64_t p, const char *rout, + const char *form, ...); #ifdef __cplusplus } diff --git a/CBLAS/include/cblas_f77.h b/CBLAS/include/cblas_f77.h index 3c5f560de..e20ee980f 100644 --- a/CBLAS/include/cblas_f77.h +++ b/CBLAS/include/cblas_f77.h @@ -59,6 +59,17 @@ #endif #endif +/* + * Weak symbol support for cblas_xerbla() and F77_xerbla() + */ +#ifndef CBLAS_WEAK_SYMBOL +#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT + #define CBLAS_WEAK_SYMBOL __attribute__((weak)) +#else + #define CBLAS_WEAK_SYMBOL +#endif +#endif + #define F77_GLOBAL_SUFFIX(a,b) F77_GLOBAL_SUFFIX_(API_SUFFIX(a),API_SUFFIX(b)) #define F77_GLOBAL_SUFFIX_(a,b) F77_GLOBAL(a,b) @@ -613,11 +624,7 @@ extern "C" { #else #define F77_xerbla(...) F77_xerbla_base(__VA_ARGS__) #endif -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -F77_xerbla_base(FCHAR, void * +void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR, void * #ifdef BLAS_FORTRAN_STRLEN_END , FORTRAN_STRLEN #endif From 2ba64b0003e29e1ca0f2fcc38ff41f68d5581828 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:35:13 +0200 Subject: [PATCH 06/13] CBLAS: provide F77_INT and FCHAR to the testing headers c_xerbla.c needs the Fortran integer and character types to declare F77_xerbla(), but the testing sources deliberately do not include cblas_f77.h: that header maps every F77_* name to the real BLAS symbol while cblas_test.h maps them to the Fortran test wrappers, and 141 of those names collide. Copy the two fallbacks into cblas_test.h instead, alongside the BLAS_FORTRAN_STRLEN_END and FORTRAN_STRLEN definitions it already duplicates for the same reason. Co-Authored-By: Claude Opus 5 (1M context) --- CBLAS/include/cblas_test.h | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/CBLAS/include/cblas_test.h b/CBLAS/include/cblas_test.h index 8cd496bbb..74d035d78 100644 --- a/CBLAS/include/cblas_test.h +++ b/CBLAS/include/cblas_test.h @@ -22,6 +22,20 @@ #define FORTRAN_STRLEN size_t #endif +#ifndef F77_INT +#ifdef WeirdNEC + #define F77_INT int64_t +#else + #define F77_INT int32_t +#endif +#endif + +#ifdef F77_CHAR + #define FCHAR F77_CHAR +#else + #define FCHAR char * +#endif + #define TRUE 1 #define PASSED 1 #define TEST_ROW_MJR 1 From bfadf61f2fc00c0055db148bfc71d538639bcf6c Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:35:13 +0200 Subject: [PATCH 07/13] CBLAS: add a shared helper header for XERBLA name and INFO handling cblas_xerbla_internal.h collects the routine-name construction and the row-major INFO remapping that the library and the test harness each open-code today, so the two copies can no longer drift apart. Relative to those copies the helper also trims the blank padding Fortran supplies, drops the _64 suffix that BUILD_INDEX64_EXT_API rewrites into the XERBLA name literals, matches operation names exactly rather than by substring, and derives its buffer size from a named maximum so that long names are clamped instead of silently truncated. It has no user yet; the xerbla sources are switched over next. Co-Authored-By: Claude Opus 5 (1M context) --- CBLAS/include/cblas_xerbla_internal.h | 203 ++++++++++++++++++++++++++ 1 file changed, 203 insertions(+) create mode 100644 CBLAS/include/cblas_xerbla_internal.h diff --git a/CBLAS/include/cblas_xerbla_internal.h b/CBLAS/include/cblas_xerbla_internal.h new file mode 100644 index 000000000..ae410fb89 --- /dev/null +++ b/CBLAS/include/cblas_xerbla_internal.h @@ -0,0 +1,203 @@ +#ifndef CBLAS_XERBLA_INTERNAL_H +#define CBLAS_XERBLA_INTERNAL_H + +#include +#include +#include + +#include "cblas.h" + +// Keep a bit of headroom for possible future CBLAS routines +#define CBLAS_XERBLA_MAX_ROUTINE_NAME 32u +#define CBLAS_XERBLA_ROUT_BUFFER_SIZE \ + (sizeof("cblas_") - 1 + CBLAS_XERBLA_MAX_ROUTINE_NAME + 1) + +/** + * \brief Length of a Fortran-style name with trailing blanks removed. + * + * \param[in] name Character data, not necessarily NUL terminated. + * \param[in] name_len Number of characters available in \p name. + * + * \return Length up to the first NUL, excluding trailing blanks, or 0 if + * \p name is NULL. + */ +static inline size_t cblas_xerbla_trimmed_length(const char *name, + size_t name_len) +{ + if (name == NULL) return 0; + + size_t actual_len = 0; + while (actual_len < name_len && name[actual_len] != '\0') { + actual_len++; + } + while (actual_len > 0 && name[actual_len - 1] == ' ') { + actual_len--; + } + + return actual_len; +} + +/** + * \brief Build the "cblas_"-prefixed routine name used in error messages. + * + * Lowercases \p name and drops trailing blanks and, in 64-bit API builds, a + * trailing "_64". The result is always NUL terminated, and is truncated + * rather than allowed to overflow \p rout. + * + * \param[out] rout Destination buffer, normally of size + * CBLAS_XERBLA_ROUT_BUFFER_SIZE. + * \param[in] rout_size Size of \p rout in bytes. + * \param[in] name Fortran routine name, not necessarily NUL + * terminated. + * \param[in] name_len Number of characters available in \p name. + */ +static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, + const char *name, size_t name_len) +{ + + if (rout_size == 0) return; + + name_len = cblas_xerbla_trimmed_length(name, name_len); + +#ifdef CBLAS_API64 + if (name_len >= 3 && name[name_len - 3] == '_' && + name[name_len - 2] == '6' && name[name_len - 1] == '4') + name_len -= 3; +#endif + + if (name_len > CBLAS_XERBLA_MAX_ROUTINE_NAME) { + name_len = CBLAS_XERBLA_MAX_ROUTINE_NAME; + } + + static const char prefix[] = "cblas_"; + size_t prefix_len = sizeof(prefix) - 1; + size_t rout_len = 0; + for (size_t i = 0; i < prefix_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = prefix[i]; + } + for (size_t i = 0; i < name_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = (char)tolower((unsigned char)name[i]); + } + + rout[rout_len] = '\0'; +} + +/** + * \brief Reduce a routine name to its bare operation. + * + * Skips the "cblas_" prefix and the precision character, so that + * "cblas_dgemm" yields "gemm". + * + * \param[in] rout CBLAS routine name, or NULL. + * + * \return Pointer into \p rout past the prefix and precision character, or + * NULL if \p rout is NULL. + */ +static inline const char *cblas_xerbla_operation(const char *rout) +{ + if (rout == NULL) return NULL; + + if (strncmp(rout, "cblas_", sizeof("cblas_") - 1) == 0) { + rout += sizeof("cblas_") - 1; + } + if ((rout[0] == 's' || rout[0] == 'd' || rout[0] == 'c' || rout[0] == 'z') && + rout[1] != '\0') { + rout++; + } + + return rout; +} + +/** + * \brief Test an operation name for equality. + * + * The comparison is exact, so "gemm" does not also match "gemmtr". + * + * \param[in] operation Result of cblas_xerbla_operation(), or NULL. + * \param[in] expected Operation name to match. + * + * \return Nonzero when \p operation equals \p expected. + */ +static inline int cblas_xerbla_operation_is(const char *operation, + const char *expected) +{ + return operation != NULL && strcmp(operation, expected) == 0; +} + +/** + * \brief Map a Fortran argument number onto its CBLAS position. + * + * Row-major calls reach the Fortran BLAS with arguments swapped or + * transposed, so the number XERBLA reports is not that of the CBLAS + * argument actually at fault. Column-major calls, and operations needing no + * adjustment, return \p info unchanged. + * + * \param[in] info Argument number reported by the Fortran BLAS. + * \param[in] rout CBLAS routine name, e.g. "cblas_dgemm". + * \param[in] row_major Nonzero if the call used CblasRowMajor. + * + * \return The corresponding CBLAS argument number. + */ +static inline CBLAS_INT cblas_xerbla_map_info(CBLAS_INT info, const char *rout, + int row_major) +{ + if (!row_major) return info; + + const char *operation = cblas_xerbla_operation(rout); + if (cblas_xerbla_operation_is(operation, "gemmtr")) { + + if (info == 11) info = 9; + else if (info == 9) info = 11; + + } else if (cblas_xerbla_operation_is(operation, "gemm")) { + + if (info == 5) info = 4; + else if (info == 4) info = 5; + else if (info == 11) info = 9; + else if (info == 9) info = 11; + + } else if (cblas_xerbla_operation_is(operation, "symm") || + cblas_xerbla_operation_is(operation, "hemm") || + cblas_xerbla_operation_is(operation, "skewsymm")) { + + if (info == 5) info = 4; + else if (info == 4) info = 5; + + } else if (cblas_xerbla_operation_is(operation, "trmm") || + cblas_xerbla_operation_is(operation, "trsm")) { + + if (info == 7) info = 6; + else if (info == 6) info = 7; + + } else if (cblas_xerbla_operation_is(operation, "gemv")) { + + if (info == 4) info = 3; + else if (info == 3) info = 4; + + } else if (cblas_xerbla_operation_is(operation, "gbmv")) { + + if (info == 4) info = 3; + else if (info == 3) info = 4; + else if (info == 6) info = 5; + else if (info == 5) info = 6; + + } else if (cblas_xerbla_operation_is(operation, "ger") || + cblas_xerbla_operation_is(operation, "geru") || + cblas_xerbla_operation_is(operation, "gerc")) { + + if (info == 3) info = 2; + else if (info == 2) info = 3; + else if (info == 8) info = 6; + else if (info == 6) info = 8; + + } else if (cblas_xerbla_operation_is(operation, "her2") || + cblas_xerbla_operation_is(operation, "hpr2")) { + + if (info == 8) info = 6; + else if (info == 6) info = 8; + } + + return info; +} + +#endif // CBLAS_XERBLA_INTERNAL_H From e2fd85389fc37881e384ff169d5709f8ab1195f8 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:35:14 +0200 Subject: [PATCH 08/13] CBLAS: use the shared XERBLA helper in the xerbla sources Switch cblas_xerbla(), F77_xerbla_base() and the test harness over to cblas_xerbla_internal.h. Two diagnostic bugs go away with the duplicated code: - the row-major remap keyed off strstr(rout, "gemm"), which also matches gemmtr and so wrongly swapped its arguments 4 and 5; - the six-character name buffer truncated cblas_sgemmtr and cblas_sskewsyr2k in the library, while the harness used an eleven-character buffer and did not, so the two disagreed about the same routine. The Fortran entry points now take FCHAR and read the argument number through F77_INT consistently, honour the hidden string length instead of assuming six characters, and carry doxygen comments. Co-Authored-By: Claude Opus 5 (1M context) --- CBLAS/src/cblas_xerbla.c | 84 +++++++-------------- CBLAS/src/xerbla.c | 83 +++++++++++--------- CBLAS/testing/c_xerbla.c | 159 ++++++++++++++++----------------------- 3 files changed, 137 insertions(+), 189 deletions(-) diff --git a/CBLAS/src/cblas_xerbla.c b/CBLAS/src/cblas_xerbla.c index f353153a4..53e8facd3 100644 --- a/CBLAS/src/cblas_xerbla.c +++ b/CBLAS/src/cblas_xerbla.c @@ -1,72 +1,42 @@ +#include #include #include -#include -#include + #include "cblas.h" #include "cblas_f77.h" +#include "cblas_xerbla_internal.h" -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form, ...) +/** + * \brief CBLAS error handler: report an invalid argument and terminate. + * + * Remaps \p info to the CBLAS argument position for row-major calls, writes + * the diagnostic to stderr and exits; it does not return to its caller. + * + * \param[in] info CBLAS argument number, or 0 to report only \p form. + * \param[in] rout Routine name, e.g. "cblas_dgemm". + * \param[in] form printf-style format for further detail, followed by the + * values it refers to. + */ +void CBLAS_WEAK_SYMBOL API_SUFFIX(cblas_xerbla)(CBLAS_INT info, + const char *rout, + const char *form, ...) { extern int RowMajorStrg; char empty[1] = ""; - va_list argptr; - va_start(argptr, form); - - if (RowMajorStrg) - { - if (strstr(rout,"gemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - else if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } - else if (strstr(rout,"symm") != 0 || strstr(rout,"hemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - } - else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0) - { - if (info == 7 ) info = 6; - else if (info == 6 ) info = 7; - } - else if (strstr(rout,"gemv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - } - else if (strstr(rout,"gbmv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - else if (info == 6) info = 5; - else if (info == 5) info = 6; - } - else if (strstr(rout,"ger") != 0) - { - if (info == 3) info = 2; - else if (info == 2) info = 3; - else if (info == 8) info = 6; - else if (info == 6) info = 8; - } - else if ( (strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0) - && strstr(rout,"her2k") == 0 ) - { - if (info == 8) info = 6; - else if (info == 6) info = 8; - } + info = cblas_xerbla_map_info(info, rout, RowMajorStrg); + if (info) { + fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine %s was incorrect\n", + info, rout); } - if (info) - fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine %s was incorrect\n", info, rout); + + va_list argptr; + va_start(argptr, form); vfprintf(stderr, form, argptr); va_end(argptr); - if (info && !info) + + if (info && !info) { F77_xerbla(empty, &info); /* Force link of our F77 error handler */ + } exit(-1); } diff --git a/CBLAS/src/xerbla.c b/CBLAS/src/xerbla.c index a7ca7869a..cb1a76a31 100644 --- a/CBLAS/src/xerbla.c +++ b/CBLAS/src/xerbla.c @@ -1,50 +1,61 @@ #include -#include + #include "cblas.h" #include "cblas_f77.h" +#include "cblas_xerbla_internal.h" -#define XerblaStrLen 6 -#define XerblaStrLen1 7 - -void -#ifdef HAS_ATTRIBUTE_WEAK_SUPPORT -__attribute__((weak)) -#endif -F77_xerbla_base -#ifdef F77_CHAR -(F77_CHAR F77_srname, void *vinfo -#else -(char *srname, void *vinfo -#endif +/** + * \brief XERBLA implementation linked in together with the CBLAS library. + * + * An error raised beneath a CBLAS wrapper is forwarded to cblas_xerbla() + * under the CBLAS spelling of the routine name, with the argument number + * shifted by one to account for the extra layout argument. Errors from + * direct Fortran calls are reported under the Fortran name instead. + * + * \param[in] F77_srname Routine name reported by the Fortran BLAS, blank + * padded and not NUL terminated. + * \param[in] vinfo Pointer to the Fortran argument number. + * \param[in] len Hidden Fortran length of \p F77_srname, on + * compilers that pass string lengths at the end of + * the argument list. + */ +void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR F77_srname, void *vinfo #ifdef BLAS_FORTRAN_STRLEN_END -, FORTRAN_STRLEN len + , + FORTRAN_STRLEN len #endif ) { -#ifdef F77_CHAR - char *srname; -#endif - - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'}; - - int *info=vinfo; - int i; - extern int CBLAS_CallFromC; -#ifdef F77_CHAR - srname = F2C_STR(F77_srname, XerblaStrLen); + size_t srname_len; +#ifdef BLAS_FORTRAN_STRLEN_END + srname_len = len > 0 ? (size_t)len : 0; +#else + srname_len = 6; #endif - if (CBLAS_CallFromC) - { - for(i=0; i != XerblaStrLen; i++) rout[i+6] = tolower(srname[i]); - rout[XerblaStrLen+6] = '\0'; - API_SUFFIX(cblas_xerbla)(*info+1,rout,""); - } - else - { - fprintf(stderr, "Parameter %d to routine %s was incorrect\n", - *info, srname); + char *srname; +#ifdef F77_CHAR + srname = F2C_STR(F77_srname, srname_len); +#else + srname = F77_srname; +#endif + + F77_INT *info = (F77_INT *)vinfo; + CBLAS_INT cblas_info = (CBLAS_INT)*info; + + if (CBLAS_CallFromC) { + char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); + API_SUFFIX(cblas_xerbla)(cblas_info + 1, rout, ""); + } else { + size_t display_len = cblas_xerbla_trimmed_length(srname, srname_len); + + fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine ", cblas_info); + if (display_len > 0) { + fwrite(srname, 1, display_len, stderr); + } + fputs(" was incorrect\n", stderr); } } diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 922a1a97c..f430a7849 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -1,16 +1,32 @@ -#include #include #include +#include #include + #include "cblas.h" #include "cblas_test.h" +#include "cblas_xerbla_internal.h" -void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form, ...) +/** + * \brief Test-harness stand-in for the CBLAS error handler. + * + * Rather than terminating, checks the reported routine name and argument + * number against the values the calling tester put in cblas_rout and + * cblas_info, and records the outcome in cblas_ok and cblas_lerr. + * + * \param[in] info CBLAS argument number reported by the caller. + * \param[in] rout Routine name, e.g. "cblas_dgemm". + * \param[in] form Unused; kept so the signature matches the library's. + */ +void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, + const char *form, ...) { extern CBLAS_INT cblas_lerr, cblas_info, cblas_ok; extern CBLAS_INT link_xerbla; extern char *cblas_rout; + (void)form; + /* Initially, c__3chke may call this routine with * global variable link_xerbla=1, and F77_xerbla will set link_xerbla=0. * This is done to fool the linker into loading these subroutines first @@ -18,120 +34,71 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, const char *form */ if (link_xerbla) return; - if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0){ - printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", rout, cblas_rout); + if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0) { + printf( + "***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", + rout, cblas_rout); cblas_ok = FALSE; } - if (RowMajorStrg) - { - /* To properly check leading dimension problems in cblas__gemm, we - * need to do the following trick. When cblas__gemm is called with - * CblasRowMajor, the arguments A and B switch places in the call to - * f77__gemm. Thus when we test for bad leading dimension problems - * for A and B, lda is in position 11 instead of 9, and ldb is in - * position 9 instead of 11. - */ - if (strstr(rout,"gemm") != 0 && strstr(rout, "gemmtr") == 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - else if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } else if (strstr(rout, "gemmtr") != 0) - { - if (info == 11) info = 9; - else if (info == 9 ) info = 11; - } + info = cblas_xerbla_map_info(info, rout, RowMajorStrg); - else if (strstr(rout,"symm") != 0 || strstr(rout,"skewsymm") != 0 || strstr(rout,"hemm") != 0) - { - if (info == 5 ) info = 4; - else if (info == 4 ) info = 5; - } - else if (strstr(rout,"trmm") != 0 || strstr(rout,"trsm") != 0) - { - if (info == 7 ) info = 6; - else if (info == 6 ) info = 7; - } - else if (strstr(rout,"gemv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - } - else if (strstr(rout,"gbmv") != 0) - { - if (info == 4) info = 3; - else if (info == 3) info = 4; - else if (info == 6) info = 5; - else if (info == 5) info = 6; - } - else if (strstr(rout,"ger") != 0) - { - if (info == 3) info = 2; - else if (info == 2) info = 3; - else if (info == 8) info = 6; - else if (info == 6) info = 8; - } - else if ( ( strstr(rout,"her2") != 0 || strstr(rout,"hpr2") != 0 ) - && strstr(rout,"her2k") == 0 ) - { - if (info == 8) info = 6; - else if (info == 6) info = 8; - } - } - - if (info != cblas_info){ - printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT " INSTEAD OF %d in %s *******\n",info, (int) cblas_info, rout); + if (info != cblas_info) { + printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT + " INSTEAD OF %d in %s *******\n", + info, (int)cblas_info, rout); cblas_lerr = PASSED; cblas_ok = FALSE; - } else cblas_lerr = FAILED; + } else { + cblas_lerr = FAILED; + } } -#ifdef F77_Char -void F77_xerbla(F77_Char F77_srname, void *vinfo -#else -void F77_xerbla(char *srname, void *vinfo -#endif +/** + * \brief Test-harness XERBLA that redirects Fortran errors to cblas_xerbla(). + * + * \param[in] F77_srname Routine name reported by the Fortran BLAS, blank + * padded and not NUL terminated. + * \param[in] vinfo Pointer to the Fortran argument number. + * \param[in] len Hidden Fortran length of \p F77_srname, on + * compilers that pass string lengths at the end. + */ +void F77_xerbla(FCHAR F77_srname, void *vinfo #ifdef BLAS_FORTRAN_STRLEN_END -, FORTRAN_STRLEN srname_len + , + FORTRAN_STRLEN len #endif ) { -#ifdef F77_Char - char *srname; -#endif - - char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0', '\0', '\0', '\0', '\0'}; - -#ifdef F77_Integer - F77_Integer *info=vinfo; - F77_Integer i; - extern F77_Integer link_xerbla; -#else - CBLAS_INT *info=vinfo; - CBLAS_INT i; - extern CBLAS_INT link_xerbla; -#endif -#ifdef F77_Char - srname = F2C_STR(F77_srname, XerblaStrLen); -#endif - /* See the comment in API_SUFFIX(cblas_xerbla)() above */ - if (link_xerbla) - { + extern CBLAS_INT link_xerbla; + if (link_xerbla) { link_xerbla = 0; return; } -#ifndef BLAS_FORTRAN_STRLEN_END - const int srname_len = 6; + + size_t srname_len; +#ifdef BLAS_FORTRAN_STRLEN_END + srname_len = len > 0 ? (size_t)len : 0; +#else + srname_len = 6; #endif - for(i=0; i < srname_len; i++) rout[i+6] = tolower(srname[i]); - for(i=16; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0'; + char *srname; +#ifdef F77_CHAR + srname = F2C_STR(F77_srname, srname_len); +#else + srname = F77_srname; +#endif + + F77_INT *info = (F77_INT *)vinfo; + CBLAS_INT cblas_info = (CBLAS_INT)*info; + + char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); /* We increment *info by 1 since the CBLAS interface adds one more * argument to all level 2 and 3 routines. */ - API_SUFFIX(cblas_xerbla)(*info+1,rout,""); + API_SUFFIX(cblas_xerbla)(cblas_info + 1, rout, ""); } From 6c493e65086132dc91d8351deacde4ae6ba967bc Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:35:14 +0200 Subject: [PATCH 09/13] CBLAS: add a clang-format configuration Describes the style the xerbla sources are written in: three-space indent, Allman braces, 80 columns, and the return type on its own line for definitions. Every option clang-format knows about is listed, with the ones inherited from the LLVM base style commented out, so that the uncommented lines are exactly what this style changes. The file applies to all of CBLAS, but the older sources here do not follow it, so format only the lines you touch, e.g. with git clang-format. Co-Authored-By: Claude Opus 5 (1M context) --- CBLAS/.clang-format | 334 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 334 insertions(+) create mode 100644 CBLAS/.clang-format diff --git a/CBLAS/.clang-format b/CBLAS/.clang-format new file mode 100644 index 000000000..1a990a6a8 --- /dev/null +++ b/CBLAS/.clang-format @@ -0,0 +1,334 @@ +# Options we simply inherit from the LLVM base style are commented out, so the +# uncommented lines are exactly what this style changes: +# +# IndentWidth / ContinuationIndentWidth 3 +# BreakBeforeBraces Linux +# AllowShortFunctionsOnASingleLine None +# AllowShortIfStatementsOnASingleLine AllIfsAndElse +# BreakAfterReturnType Automatic +# IncludeCategories system headers, then project +# +# Generated against clang-format 22; a run of --dump-config there reproduces +# this file's settings. Older releases will not recognise every +# uncommented key (BreakAfterReturnType and the SortIncludes struct are 19+), +# but commented lines are inert, so they cost nothing. + +BasedOnStyle: LLVM + +Language: Cpp +# AlignAfterOpenBracket: true +# AccessModifierOffset: -2 +# AlignArrayOfStructures: None +# AlignConsecutiveAssignments: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: true +# AlignConsecutiveBitFields: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveDeclarations: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: true +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveMacros: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveShortCaseStatements: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCaseArrows: false +# AlignCaseColons: false +# AlignConsecutiveTableGenBreakingDAGArgColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveTableGenCondOperatorColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignConsecutiveTableGenDefinitionColons: +# Enabled: false +# AcrossEmptyLines: false +# AcrossComments: false +# AlignCompound: false +# AlignFunctionDeclarations: false +# AlignFunctionPointers: false +# PadOperators: false +# AlignEscapedNewlines: Right +# AlignOperands: Align +# AlignTrailingComments: +# AlignPPAndNotPP: true +# Kind: Always +# OverEmptyLines: 0 +# AllowAllArgumentsOnNextLine: true +# AllowAllParametersOfDeclarationOnNextLine: true +# AllowBreakBeforeNoexceptSpecifier: Never +# AllowBreakBeforeQtProperty: false +# AllowShortBlocksOnASingleLine: Never +# AllowShortCaseExpressionOnASingleLine: true +# AllowShortCaseLabelsOnASingleLine: false +# AllowShortCompoundRequirementOnASingleLine: true +# AllowShortEnumsOnASingleLine: true +AllowShortFunctionsOnASingleLine: None +AllowShortIfStatementsOnASingleLine: AllIfsAndElse +# AllowShortLambdasOnASingleLine: All +# AllowShortLoopsOnASingleLine: false +# AllowShortNamespacesOnASingleLine: false +# AlwaysBreakAfterDefinitionReturnType: None +# AlwaysBreakBeforeMultilineStrings: false +# AttributeMacros: +# - __capability +# BinPackArguments: true +# BinPackLongBracedList: true +# BinPackParameters: BinPack +# BitFieldColonSpacing: Both +# BracedInitializerIndentWidth: -1 +# BraceWrapping: +# AfterCaseLabel: true +# AfterClass: true +# AfterControlStatement: Always +# AfterEnum: true +# AfterExternBlock: true +# AfterFunction: true +# AfterNamespace: true +# AfterObjCDeclaration: true +# AfterStruct: true +# AfterUnion: true +# BeforeCatch: true +# BeforeElse: true +# BeforeLambdaBody: true +# BeforeWhile: false +# IndentBraces: false +# SplitEmptyFunction: true +# SplitEmptyRecord: true +# SplitEmptyNamespace: true +# BreakAdjacentStringLiterals: true +# BreakAfterAttributes: Leave +# BreakAfterJavaFieldAnnotations: false +# BreakAfterOpenBracketBracedList: false +# BreakAfterOpenBracketFunction: false +# BreakAfterOpenBracketIf: false +# BreakAfterOpenBracketLoop: false +# BreakAfterOpenBracketSwitch: false +# Definitions carry the return type on its own line: +# static inline size_t +# cblas_xerbla_trimmed_length(const char *name, size_t name_len) +# Spelled AlwaysBreakAfterReturnType before clang-format 19. +BreakAfterReturnType: Automatic +# BreakArrays: true +# BreakBeforeBinaryOperators: None +# BreakBeforeCloseBracketBracedList: false +# BreakBeforeCloseBracketFunction: false +# BreakBeforeCloseBracketIf: false +# BreakBeforeCloseBracketLoop: false +# BreakBeforeCloseBracketSwitch: false +# BreakBeforeConceptDeclarations: Always +BreakBeforeBraces: Linux +# BreakBeforeInlineASMColon: OnlyMultiline +# BreakBeforeTemplateCloser: false +# BreakBeforeTernaryOperators: true +# BreakBinaryOperations: Never +# BreakConstructorInitializers: BeforeColon +# BreakFunctionDefinitionParameters: false +# BreakInheritanceList: BeforeColon +# BreakStringLiterals: true +# BreakTemplateDeclarations: MultiLine +# ColumnLimit: 80 +# CommentPragmas: '^ IWYU pragma:' +# CompactNamespaces: false +# ConstructorInitializerIndentWidth: 4 +ContinuationIndentWidth: 3 +# Cpp11BracedListStyle: AlignFirstComment +# DerivePointerAlignment: false +# DisableFormat: false +# EmptyLineAfterAccessModifier: Never +# EmptyLineBeforeAccessModifier: LogicalBlock +# EnumTrailingComma: Leave +# ExperimentalAutoDetectBinPacking: false +# FixNamespaceComments: true +# ForEachMacros: +# - foreach +# - Q_FOREACH +# - BOOST_FOREACH +# IfMacros: +# - KJ_IF_MAYBE +IncludeCategories: + - Regex: '^<' + Priority: 1 + - Regex: 'cblas.*' + Priority: 2 + - Regex: '.*' + Priority: 3 +# IncludeIsMainRegex: '(Test)?$' +# IncludeIsMainSourceRegex: '' +# IndentAccessModifiers: false +# IndentCaseBlocks: false +# IndentCaseLabels: false +# IndentExportBlock: true +# IndentExternBlock: AfterExternBlock +# IndentGotoLabels: true +# IndentPPDirectives: None +# IndentRequiresClause: true +IndentWidth: 3 +# IndentWrappedFunctionNames: false +# InsertBraces: true +# InsertNewlineAtEOF: false +# InsertTrailingCommas: None +# IntegerLiteralSeparator: +# Binary: 0 +# BinaryMinDigitsInsert: 0 +# BinaryMaxDigitsRemove: 0 +# Decimal: 0 +# DecimalMinDigitsInsert: 0 +# DecimalMaxDigitsRemove: 0 +# Hex: 0 +# HexMinDigitsInsert: 0 +# HexMaxDigitsRemove: 0 +# BinaryMinDigits: 0 +# DecimalMinDigits: 0 +# HexMinDigits: 0 +# JavaScriptQuotes: Leave +# JavaScriptWrapImports: true +# KeepEmptyLines: +# AtEndOfFile: false +# AtStartOfBlock: true +# AtStartOfFile: true +# KeepFormFeed: false +# LambdaBodyIndentation: Signature +# LineEnding: DeriveLF +# MacroBlockBegin: '' +# MacroBlockEnd: '' +# MainIncludeChar: Quote +# MaxEmptyLinesToKeep: 1 +# NamespaceIndentation: None +# NumericLiteralCase: +# ExponentLetter: Leave +# HexDigit: Leave +# Prefix: Leave +# Suffix: Leave +# ObjCBinPackProtocolList: Auto +# ObjCBlockIndentWidth: 2 +# ObjCBreakBeforeNestedBlockParam: true +# ObjCSpaceAfterProperty: false +# ObjCSpaceBeforeProtocolList: true +# OneLineFormatOffRegex: '' +# PackConstructorInitializers: BinPack +# PenaltyBreakAssignment: 2 +# PenaltyBreakBeforeFirstCallParameter: 19 +# PenaltyBreakBeforeMemberAccess: 150 +# PenaltyBreakComment: 300 +# PenaltyBreakFirstLessLess: 120 +# PenaltyBreakOpenParenthesis: 0 +# PenaltyBreakScopeResolution: 500 +# PenaltyBreakString: 1000 +# PenaltyBreakTemplateDeclaration: 10 +# PenaltyExcessCharacter: 1000000 +# PenaltyIndentedWhitespace: 0 +# PenaltyReturnTypeOnItsOwnLine: 60 +# PointerAlignment: Right +# PPIndentWidth: -1 +# QualifierAlignment: Leave +# ReferenceAlignment: Pointer +# ReflowComments: Always +# RemoveBracesLLVM: false +# RemoveEmptyLinesInUnwrappedLines: false +# RemoveParentheses: Leave +# RemoveSemicolon: false +# RequiresClausePosition: OwnLine +# RequiresExpressionIndentation: OuterScope +# SeparateDefinitionBlocks: Leave +# ShortNamespaceLines: 1 +# SkipMacroDefinitionBody: false +# Sorting is LLVM's default and is deliberately left on; the grouping it +# produces comes from the IncludeCategories priorities above. +# SortIncludes: +# Enabled: true +# IgnoreCase: false +# IgnoreExtension: false +# SortJavaStaticImport: Before +# SortUsingDeclarations: LexicographicNumeric +# SpaceAfterCStyleCast: false +# SpaceAfterLogicalNot: false +# SpaceAfterOperatorKeyword: false +# SpaceAfterTemplateKeyword: true +# SpaceAroundPointerQualifiers: Default +# SpaceBeforeAssignmentOperators: true +# SpaceBeforeCaseColon: false +# SpaceBeforeCpp11BracedList: false +# SpaceBeforeCtorInitializerColon: true +# SpaceBeforeInheritanceColon: true +# SpaceBeforeJsonColon: false +# SpaceBeforeParens: ControlStatements +# SpaceBeforeParensOptions: +# AfterControlStatements: true +# AfterForeachMacros: true +# AfterFunctionDefinitionName: false +# AfterFunctionDeclarationName: false +# AfterIfMacros: true +# AfterNot: false +# AfterOverloadedOperator: false +# AfterPlacementOperator: true +# AfterRequiresInClause: false +# AfterRequiresInExpression: false +# BeforeNonEmptyParentheses: false +# SpaceBeforeRangeBasedForLoopColon: true +# SpaceBeforeSquareBrackets: false +# SpaceInEmptyBraces: Never +# SpacesBeforeTrailingComments: 1 +# SpacesInAngles: Never +# SpacesInContainerLiterals: true +# SpacesInLineCommentPrefix: +# Minimum: 1 +# Maximum: -1 +# SpacesInParens: Never +# SpacesInParensOptions: +# ExceptDoubleParentheses: false +# InCStyleCasts: false +# InConditionalStatements: false +# InEmptyParentheses: false +# Other: false +# SpacesInSquareBrackets: false +# Standard: Latest +# StatementAttributeLikeMacros: +# - Q_EMIT +# StatementMacros: +# - Q_UNUSED +# - QT_REQUIRE_VERSION +# TableGenBreakInsideDAGArg: DontBreak +# TabWidth: 8 +# UseTab: Never +# VerilogBreakBetweenInstancePorts: true +# WhitespaceSensitiveMacros: +# - BOOST_PP_STRINGIZE +# - CF_SWIFT_NAME +# - NS_SWIFT_NAME +# - PP_STRINGIZE +# - STRINGIZE +# WrapNamespaceBodyWithEmptyLines: Leave From 3cd79c329f24ac6c453bd5d704b2ae1748db1faa Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Tue, 28 Jul 2026 21:59:49 +0200 Subject: [PATCH 10/13] Remove unnecessary (int) casts of info return values in CBLAS tests --- CBLAS/examples/cblas_example1_64.c | 2 +- CBLAS/testing/c_c2chke.c | 2 +- CBLAS/testing/c_c3chke.c | 2 +- CBLAS/testing/c_d2chke.c | 2 +- CBLAS/testing/c_d3chke.c | 2 +- CBLAS/testing/c_s2chke.c | 2 +- CBLAS/testing/c_s3chke.c | 2 +- CBLAS/testing/c_xerbla.c | 4 ++-- CBLAS/testing/c_z2chke.c | 2 +- CBLAS/testing/c_z3chke.c | 2 +- 10 files changed, 11 insertions(+), 11 deletions(-) diff --git a/CBLAS/examples/cblas_example1_64.c b/CBLAS/examples/cblas_example1_64.c index 2dfcb7309..99c1f55f6 100644 --- a/CBLAS/examples/cblas_example1_64.c +++ b/CBLAS/examples/cblas_example1_64.c @@ -61,7 +61,7 @@ int main ( ) y, incy ); /* Print y */ for( i = 0; i < n; i++ ) - printf(" y%d = %f\n", (int) i, y[i]); + printf(" y%" PRId64 " = %f\n", i, y[i]); free(a); free(x); free(y); diff --git a/CBLAS/testing/c_c2chke.c b/CBLAS/testing/c_c2chke.c index cba0712a2..8a93bcce7 100644 --- a/CBLAS/testing/c_c2chke.c +++ b/CBLAS/testing/c_c2chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_c3chke.c b/CBLAS/testing/c_c3chke.c index a478a0cfc..8c1925c07 100644 --- a/CBLAS/testing/c_c3chke.c +++ b/CBLAS/testing/c_c3chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_d2chke.c b/CBLAS/testing/c_d2chke.c index d6b4160f9..dea600b1b 100644 --- a/CBLAS/testing/c_d2chke.c +++ b/CBLAS/testing/c_d2chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_d3chke.c b/CBLAS/testing/c_d3chke.c index 5ef472c14..57d83a33e 100644 --- a/CBLAS/testing/c_d3chke.c +++ b/CBLAS/testing/c_d3chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_s2chke.c b/CBLAS/testing/c_s2chke.c index 89940b481..9e195b938 100644 --- a/CBLAS/testing/c_s2chke.c +++ b/CBLAS/testing/c_s2chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_s3chke.c b/CBLAS/testing/c_s3chke.c index 6ca1bb8c9..b551cca82 100644 --- a/CBLAS/testing/c_s3chke.c +++ b/CBLAS/testing/c_s3chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index f430a7849..10f4390c8 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -45,8 +45,8 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, if (info != cblas_info) { printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT - " INSTEAD OF %d in %s *******\n", - info, (int)cblas_info, rout); + " INSTEAD OF %" CBLAS_IFMT " in %s *******\n", + info, cblas_info, rout); cblas_lerr = PASSED; cblas_ok = FALSE; } else { diff --git a/CBLAS/testing/c_z2chke.c b/CBLAS/testing/c_z2chke.c index 651c82f03..06895204e 100644 --- a/CBLAS/testing/c_z2chke.c +++ b/CBLAS/testing/c_z2chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; diff --git a/CBLAS/testing/c_z3chke.c b/CBLAS/testing/c_z3chke.c index d7ced2b32..6284ddba6 100644 --- a/CBLAS/testing/c_z3chke.c +++ b/CBLAS/testing/c_z3chke.c @@ -22,7 +22,7 @@ void chkxer(void) { extern CBLAS_INT link_xerbla; extern char *cblas_rout; if (cblas_lerr == 1 ) { - printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout); + printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %" CBLAS_IFMT " NOT DETECTED BY %s *****\n", cblas_info, cblas_rout); cblas_ok = 0 ; } cblas_lerr = 1 ; From 745782750e5f83470cca59544dcfaaf45e1a14bc Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Jul 2026 12:38:57 +0200 Subject: [PATCH 11/13] Report the cblas routine in xerbla with the _64 suffix in extended API builds --- CBLAS/include/cblas_xerbla_internal.h | 80 +++++++++++++++++++++++---- CBLAS/src/cblas_xerbla.c | 5 +- CBLAS/testing/c_xerbla.c | 16 ++++-- 3 files changed, 85 insertions(+), 16 deletions(-) diff --git a/CBLAS/include/cblas_xerbla_internal.h b/CBLAS/include/cblas_xerbla_internal.h index ae410fb89..f0a34994c 100644 --- a/CBLAS/include/cblas_xerbla_internal.h +++ b/CBLAS/include/cblas_xerbla_internal.h @@ -9,8 +9,16 @@ // Keep a bit of headroom for possible future CBLAS routines #define CBLAS_XERBLA_MAX_ROUTINE_NAME 32u +#define CBLAS_XERBLA_API64_SUFFIX "_64" +#ifdef CBLAS_API64 +#define CBLAS_XERBLA_API_SUFFIX CBLAS_XERBLA_API64_SUFFIX +#else +#define CBLAS_XERBLA_API_SUFFIX "" +#endif + #define CBLAS_XERBLA_ROUT_BUFFER_SIZE \ - (sizeof("cblas_") - 1 + CBLAS_XERBLA_MAX_ROUTINE_NAME + 1) + ((sizeof("cblas_") - 1) + CBLAS_XERBLA_MAX_ROUTINE_NAME + \ + (sizeof(CBLAS_XERBLA_API_SUFFIX) - 1) + 1) /** * \brief Length of a Fortran-style name with trailing blanks removed. @@ -54,16 +62,16 @@ static inline size_t cblas_xerbla_trimmed_length(const char *name, static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, const char *name, size_t name_len) { - if (rout_size == 0) return; name_len = cblas_xerbla_trimmed_length(name, name_len); -#ifdef CBLAS_API64 - if (name_len >= 3 && name[name_len - 3] == '_' && - name[name_len - 2] == '6' && name[name_len - 1] == '4') - name_len -= 3; -#endif + static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; + size_t suffix_len = sizeof(suffix) - 1; + if (suffix_len > 0 && name_len >= suffix_len && + strncmp(name + name_len - suffix_len, suffix, suffix_len) == 0) { + name_len -= suffix_len; + } if (name_len > CBLAS_XERBLA_MAX_ROUTINE_NAME) { name_len = CBLAS_XERBLA_MAX_ROUTINE_NAME; @@ -82,6 +90,49 @@ static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, rout[rout_len] = '\0'; } +/** + * \brief Copy a routine name as it should be reported to the user. + * + * Appends the extended API suffix, so that a 64-bit build names + * cblas_dgemm_64() rather than cblas_dgemm() in its diagnostics. A name that + * already carries the suffix is copied unchanged, which keeps the call + * idempotent whatever the caller passes. The result is always NUL terminated + * and is truncated rather than allowed to overflow \p rout. + * + * \param[out] rout Destination buffer, normally of size + * CBLAS_XERBLA_ROUT_BUFFER_SIZE. + * \param[in] rout_size Size of \p rout in bytes. + * \param[in] name Routine name, e.g. "cblas_dgemm", or NULL. + */ +static inline void cblas_xerbla_apply_api_suffix(char *rout, size_t rout_size, + const char *name) +{ + if (rout_size == 0) return; + + if (name == NULL) { + rout[0] = '\0'; + return; + } + + static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; + size_t suffix_len = sizeof(suffix) - 1; + size_t name_len = strlen(name); + if (suffix_len > 0 && name_len >= suffix_len && + strcmp(name + name_len - suffix_len, suffix) == 0) { + suffix_len = 0; + } + + size_t rout_len = 0; + for (size_t i = 0; i < name_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = name[i]; + } + for (size_t i = 0; i < suffix_len && rout_len + 1 < rout_size; i++) { + rout[rout_len++] = suffix[i]; + } + + rout[rout_len] = '\0'; +} + /** * \brief Reduce a routine name to its bare operation. * @@ -111,17 +162,26 @@ static inline const char *cblas_xerbla_operation(const char *rout) /** * \brief Test an operation name for equality. * - * The comparison is exact, so "gemm" does not also match "gemmtr". + * The comparison is exact, so "gemm" does not also match "gemmtr". A trailing + * extended API suffix is tolerated, so that a name arriving already suffixed + * still selects the right remapping rather than silently selecting none. * * \param[in] operation Result of cblas_xerbla_operation(), or NULL. * \param[in] expected Operation name to match. * - * \return Nonzero when \p operation equals \p expected. + * \return Nonzero when \p operation equals \p expected, ignoring any trailing + * extended API suffix. */ static inline int cblas_xerbla_operation_is(const char *operation, const char *expected) { - return operation != NULL && strcmp(operation, expected) == 0; + if (operation == NULL) return 0; + + size_t expected_len = strlen(expected); + if (strncmp(operation, expected, expected_len) != 0) return 0; + + return operation[expected_len] == '\0' || + strcmp(operation + expected_len, CBLAS_XERBLA_API64_SUFFIX) == 0; } /** diff --git a/CBLAS/src/cblas_xerbla.c b/CBLAS/src/cblas_xerbla.c index 53e8facd3..a4ceae3b9 100644 --- a/CBLAS/src/cblas_xerbla.c +++ b/CBLAS/src/cblas_xerbla.c @@ -26,8 +26,11 @@ void CBLAS_WEAK_SYMBOL API_SUFFIX(cblas_xerbla)(CBLAS_INT info, info = cblas_xerbla_map_info(info, rout, RowMajorStrg); if (info) { + char reported[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(reported, sizeof(reported), rout); + fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine %s was incorrect\n", - info, rout); + info, reported); } va_list argptr; diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index 10f4390c8..ff0515994 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -34,10 +34,16 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, */ if (link_xerbla) return; - if (cblas_rout != NULL && strcmp(cblas_rout, rout) != 0) { + /* The name is checked and reported as the user would see it, suffix and + * all, while the remapping below keys off the unsuffixed \p rout. + */ + char reported[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; + cblas_xerbla_apply_api_suffix(reported, sizeof(reported), rout); + + if (cblas_rout != NULL && strcmp(cblas_rout, reported) != 0) { printf( "***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", - rout, cblas_rout); + reported, cblas_rout); cblas_ok = FALSE; } @@ -46,7 +52,7 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, if (info != cblas_info) { printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT " INSTEAD OF %" CBLAS_IFMT " in %s *******\n", - info, cblas_info, rout); + info, cblas_info, reported); cblas_lerr = PASSED; cblas_ok = FALSE; } else { @@ -65,8 +71,8 @@ void API_SUFFIX(cblas_xerbla)(CBLAS_INT info, const char *rout, */ void F77_xerbla(FCHAR F77_srname, void *vinfo #ifdef BLAS_FORTRAN_STRLEN_END - , - FORTRAN_STRLEN len + , + FORTRAN_STRLEN len #endif ) { From d270dac898cd665f62cff00eaa91cfc27a4dfccb Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Jul 2026 12:52:44 +0200 Subject: [PATCH 12/13] Apply const where possible. Use CBLAS_XERBLA_API_PREFIX instead of plain "cblas_" --- CBLAS/include/cblas_xerbla_internal.h | 30 +++++++++++++++------------ CBLAS/src/xerbla.c | 17 +++++++-------- CBLAS/testing/c_xerbla.c | 14 ++++++------- 3 files changed, 31 insertions(+), 30 deletions(-) diff --git a/CBLAS/include/cblas_xerbla_internal.h b/CBLAS/include/cblas_xerbla_internal.h index f0a34994c..09575ca90 100644 --- a/CBLAS/include/cblas_xerbla_internal.h +++ b/CBLAS/include/cblas_xerbla_internal.h @@ -9,6 +9,7 @@ // Keep a bit of headroom for possible future CBLAS routines #define CBLAS_XERBLA_MAX_ROUTINE_NAME 32u +#define CBLAS_XERBLA_API_PREFIX "cblas_" #define CBLAS_XERBLA_API64_SUFFIX "_64" #ifdef CBLAS_API64 #define CBLAS_XERBLA_API_SUFFIX CBLAS_XERBLA_API64_SUFFIX @@ -17,7 +18,7 @@ #endif #define CBLAS_XERBLA_ROUT_BUFFER_SIZE \ - ((sizeof("cblas_") - 1) + CBLAS_XERBLA_MAX_ROUTINE_NAME + \ + ((sizeof(CBLAS_XERBLA_API_PREFIX) - 1) + CBLAS_XERBLA_MAX_ROUTINE_NAME + \ (sizeof(CBLAS_XERBLA_API_SUFFIX) - 1) + 1) /** @@ -30,7 +31,7 @@ * \p name is NULL. */ static inline size_t cblas_xerbla_trimmed_length(const char *name, - size_t name_len) + const size_t name_len) { if (name == NULL) return 0; @@ -59,7 +60,7 @@ static inline size_t cblas_xerbla_trimmed_length(const char *name, * terminated. * \param[in] name_len Number of characters available in \p name. */ -static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, +static inline void cblas_xerbla_make_rout(char *rout, const size_t rout_size, const char *name, size_t name_len) { if (rout_size == 0) return; @@ -67,7 +68,7 @@ static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, name_len = cblas_xerbla_trimmed_length(name, name_len); static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; - size_t suffix_len = sizeof(suffix) - 1; + const size_t suffix_len = sizeof(suffix) - 1; if (suffix_len > 0 && name_len >= suffix_len && strncmp(name + name_len - suffix_len, suffix, suffix_len) == 0) { name_len -= suffix_len; @@ -77,8 +78,8 @@ static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, name_len = CBLAS_XERBLA_MAX_ROUTINE_NAME; } - static const char prefix[] = "cblas_"; - size_t prefix_len = sizeof(prefix) - 1; + static const char prefix[] = CBLAS_XERBLA_API_PREFIX; + const size_t prefix_len = sizeof(prefix) - 1; size_t rout_len = 0; for (size_t i = 0; i < prefix_len && rout_len + 1 < rout_size; i++) { rout[rout_len++] = prefix[i]; @@ -104,7 +105,8 @@ static inline void cblas_xerbla_make_rout(char *rout, size_t rout_size, * \param[in] rout_size Size of \p rout in bytes. * \param[in] name Routine name, e.g. "cblas_dgemm", or NULL. */ -static inline void cblas_xerbla_apply_api_suffix(char *rout, size_t rout_size, +static inline void cblas_xerbla_apply_api_suffix(char *rout, + const size_t rout_size, const char *name) { if (rout_size == 0) return; @@ -116,7 +118,7 @@ static inline void cblas_xerbla_apply_api_suffix(char *rout, size_t rout_size, static const char suffix[] = CBLAS_XERBLA_API_SUFFIX; size_t suffix_len = sizeof(suffix) - 1; - size_t name_len = strlen(name); + const size_t name_len = strlen(name); if (suffix_len > 0 && name_len >= suffix_len && strcmp(name + name_len - suffix_len, suffix) == 0) { suffix_len = 0; @@ -148,8 +150,10 @@ static inline const char *cblas_xerbla_operation(const char *rout) { if (rout == NULL) return NULL; - if (strncmp(rout, "cblas_", sizeof("cblas_") - 1) == 0) { - rout += sizeof("cblas_") - 1; + static const char prefix[] = CBLAS_XERBLA_API_PREFIX; + const size_t prefix_len = sizeof(prefix) - 1; + if (strncmp(rout, prefix, prefix_len) == 0) { + rout += prefix_len; } if ((rout[0] == 's' || rout[0] == 'd' || rout[0] == 'c' || rout[0] == 'z') && rout[1] != '\0') { @@ -177,7 +181,7 @@ static inline int cblas_xerbla_operation_is(const char *operation, { if (operation == NULL) return 0; - size_t expected_len = strlen(expected); + const size_t expected_len = strlen(expected); if (strncmp(operation, expected, expected_len) != 0) return 0; return operation[expected_len] == '\0' || @@ -199,11 +203,11 @@ static inline int cblas_xerbla_operation_is(const char *operation, * \return The corresponding CBLAS argument number. */ static inline CBLAS_INT cblas_xerbla_map_info(CBLAS_INT info, const char *rout, - int row_major) + const int row_major) { if (!row_major) return info; - const char *operation = cblas_xerbla_operation(rout); + const char *const operation = cblas_xerbla_operation(rout); if (cblas_xerbla_operation_is(operation, "gemmtr")) { if (info == 11) info = 9; diff --git a/CBLAS/src/xerbla.c b/CBLAS/src/xerbla.c index cb1a76a31..197b2bd86 100644 --- a/CBLAS/src/xerbla.c +++ b/CBLAS/src/xerbla.c @@ -28,29 +28,28 @@ void CBLAS_WEAK_SYMBOL F77_xerbla_base(FCHAR F77_srname, void *vinfo { extern int CBLAS_CallFromC; - size_t srname_len; #ifdef BLAS_FORTRAN_STRLEN_END - srname_len = len > 0 ? (size_t)len : 0; + const size_t srname_len = len > 0 ? (size_t)len : 0; #else - srname_len = 6; + const size_t srname_len = 6; #endif - char *srname; #ifdef F77_CHAR - srname = F2C_STR(F77_srname, srname_len); + const char *srname = F2C_STR(F77_srname, srname_len); #else - srname = F77_srname; + const char *srname = F77_srname; #endif - F77_INT *info = (F77_INT *)vinfo; - CBLAS_INT cblas_info = (CBLAS_INT)*info; + const F77_INT *info = (const F77_INT *)vinfo; + const CBLAS_INT cblas_info = (CBLAS_INT)*info; if (CBLAS_CallFromC) { char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); API_SUFFIX(cblas_xerbla)(cblas_info + 1, rout, ""); } else { - size_t display_len = cblas_xerbla_trimmed_length(srname, srname_len); + const size_t display_len = + cblas_xerbla_trimmed_length(srname, srname_len); fprintf(stderr, "Parameter %" CBLAS_IFMT " to routine ", cblas_info); if (display_len > 0) { diff --git a/CBLAS/testing/c_xerbla.c b/CBLAS/testing/c_xerbla.c index ff0515994..b613ea921 100644 --- a/CBLAS/testing/c_xerbla.c +++ b/CBLAS/testing/c_xerbla.c @@ -83,22 +83,20 @@ void F77_xerbla(FCHAR F77_srname, void *vinfo return; } - size_t srname_len; #ifdef BLAS_FORTRAN_STRLEN_END - srname_len = len > 0 ? (size_t)len : 0; + const size_t srname_len = len > 0 ? (size_t)len : 0; #else - srname_len = 6; + const size_t srname_len = 6; #endif - char *srname; #ifdef F77_CHAR - srname = F2C_STR(F77_srname, srname_len); + const char *srname = F2C_STR(F77_srname, srname_len); #else - srname = F77_srname; + const char *srname = F77_srname; #endif - F77_INT *info = (F77_INT *)vinfo; - CBLAS_INT cblas_info = (CBLAS_INT)*info; + const F77_INT *info = (const F77_INT *)vinfo; + const CBLAS_INT cblas_info = (CBLAS_INT)*info; char rout[CBLAS_XERBLA_ROUT_BUFFER_SIZE]; cblas_xerbla_make_rout(rout, sizeof(rout), srname, srname_len); From f0b01be34aa37e78fe84d55260c8284f86682469 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Wed, 29 Jul 2026 14:16:09 +0200 Subject: [PATCH 13/13] Ignore shared libraries and debugging info anywhere in the tree --- .gitignore | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/.gitignore b/.gitignore index cd6f0ad02..858e8f7a0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,5 +1,9 @@ # ignore objects and archives, anywhere in the tree. *.[oa] +*.so +*.dll +*.dylib +*.pdb # test in INSTALL INSTALL/test*