Skip to content

Fix cblas_xerbla wrong parameter dectection #1150

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Jul 30, 2025
Merged

Fix cblas_xerbla wrong parameter dectection #1150

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e3951fb
fix linkage of cblas_xerbla
grisuthedragon Jul 29, 2025
426641c
Fix wrong calls do dchk6 and schk6 and string length in xerbla
grisuthedragon Jul 30, 2025
f721480
Merge branch 'Reference-LAPACK:master' into cblas-xerbla-fix
grisuthedragon Jul 30, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions CBLAS/testing/c_c2chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_c2chke(char *rout
Expand All @@ -52,7 +51,7 @@ void F77_c2chke(char *rout
F77_xerbla(cblas_rout,&cblas_info, 1);
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_c3chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_c3chke(char * rout
Expand Down Expand Up @@ -56,6 +55,7 @@ void F77_c3chke(char * rout
}
#endif

link_xerbla = 0;
if (strncmp( sf,"cblas_cgemmtr" ,13)==0) {
cblas_rout = "cblas_cgemmtr" ;

Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_d2chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_d2chke(char *rout
Expand All @@ -51,6 +50,7 @@ void F77_d2chke(char *rout
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_d3chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_d3chke(char *rout
Expand All @@ -51,6 +50,7 @@ void F77_d3chke(char *rout
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
32 changes: 16 additions & 16 deletions CBLAS/testing/c_dblat3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -84,10 +84,10 @@ PROGRAM DBLAT3
INTRINSIC MAX, MIN
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
CHARACTER*13 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Data statements ..
DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ',
Expand Down Expand Up @@ -365,14 +365,14 @@ PROGRAM DBLAT3
185 IF (CORDER) THEN
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
$ 0 )
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
$ CC, CS, CT, G, 0 )
END IF
IF (RORDER) THEN
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
$ 1 )
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
$ CC, CS, CT, G, 1 )
END IF
GO TO 190

Expand Down Expand Up @@ -478,9 +478,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICH/'NTC'/
* .. Executable Statements ..
Expand Down Expand Up @@ -802,9 +802,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHS/'LR'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1113,9 +1113,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1472,9 +1472,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHT/'NTC'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1789,9 +1789,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHT/'NTC'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_s2chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_s2chke(char *rout
Expand All @@ -51,6 +50,7 @@ void F77_s2chke(char *rout
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_s3chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;

}

Expand All @@ -52,6 +51,7 @@ void F77_s3chke(char *rout
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
33 changes: 16 additions & 17 deletions CBLAS/testing/c_sblat3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -85,10 +85,10 @@ PROGRAM SBLAT3
INTRINSIC MAX, MIN
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
CHARACTER*13 SRNAMT
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
COMMON /SRNAMC/SRNAMT
* .. Data statements ..
DATA SNAMES/'cblas_sgemm ', 'cblas_ssymm ',
Expand Down Expand Up @@ -365,15 +365,14 @@ PROGRAM SBLAT3
185 IF (CORDER) THEN
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
$ 0 )

$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
$ CC, CS, CT, G, 0 )
END IF
IF (RORDER) THEN
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
$ 1 )
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
$ CC, CS, CT, G, 1 )
END IF
GO TO 190
*
Expand Down Expand Up @@ -480,9 +479,9 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICH/'NTC'/
* .. Executable Statements ..
Expand Down Expand Up @@ -808,9 +807,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHS/'LR'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1119,9 +1118,9 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1479,9 +1478,9 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHT/'NTC'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down Expand Up @@ -1796,9 +1795,9 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
INTRINSIC MAX
* .. Scalars in Common ..
INTEGER INFOT, NOUTC
LOGICAL OK
LOGICAL LERR, OK
* .. Common blocks ..
COMMON /INFOC/INFOT, NOUTC, OK
COMMON /INFOC/INFOT, NOUTC, OK, LERR
* .. Data statements ..
DATA ICHT/'NTC'/, ICHU/'UL'/
* .. Executable Statements ..
Expand Down
10 changes: 7 additions & 3 deletions CBLAS/testing/c_xerbla.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -103,7 +103,7 @@ void F77_xerbla(char *srname, void *vinfo
char *srname;
#endif

char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0'};
char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0', '\0', '\0'};

#ifdef F77_Integer
F77_Integer *info=vinfo;
Expand All @@ -124,8 +124,12 @@ void F77_xerbla(char *srname, void *vinfo
link_xerbla = 0;
return;
}
for(i=0; i < 7; i++) rout[i+6] = tolower(srname[i]);
for(i=12; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
#ifndef BLAS_FORTRAN_STRLEN_END
const int srname_len = 6;
#endif

for(i=0; i < srname_len; i++) rout[i+6] = tolower(srname[i]);
for(i=13; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';

/* We increment *info by 1 since the CBLAS interface adds one more
* argument to all level 2 and 3 routines.
Expand Down
2 changes: 1 addition & 1 deletion CBLAS/testing/c_z2chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_z2chke(char *rout
Expand All @@ -53,6 +52,7 @@ void F77_z2chke(char *rout
}
#endif

link_xerbla = 0;
cblas_ok = TRUE ;
cblas_lerr = PASSED ;

Expand Down
3 changes: 2 additions & 1 deletion CBLAS/testing/c_z3chke.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,6 @@ void chkxer(void) {
cblas_ok = 0 ;
}
cblas_lerr = 1 ;
link_xerbla = TRUE;
}

void F77_z3chke(char *rout
Expand Down Expand Up @@ -55,6 +54,8 @@ void F77_z3chke(char *rout
F77_xerbla(cblas_rout,&cblas_info, 1);
}
#endif

link_xerbla = 0;
if (strncmp( sf,"cblas_zgemmtr" ,13)==0) {
cblas_rout = "cblas_zgemmtr" ;

Expand Down
Loading