Skip to content

Commit bfbef59

Browse files
langoulangou
authored
Merge pull request #1150 from grisuthedragon/cblas-xerbla-fix
Fix cblas_xerbla wrong parameter dectection
2 parents 881bf80 + f721480 commit bfbef59

File tree

11 files changed

+48
-45
lines changed

11 files changed

+48
-45
lines changed

‎CBLAS/testing/c_c2chke.c‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_c2chke(char *rout
@@ -52,7 +51,7 @@ void F77_c2chke(char *rout
5251
F77_xerbla(cblas_rout,&cblas_info, 1);
5352
}
5453
#endif
55-
54+
link_xerbla = 0;
5655
cblas_ok = TRUE ;
5756
cblas_lerr = PASSED ;
5857

‎CBLAS/testing/c_c3chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_c3chke(char * rout
@@ -56,6 +55,7 @@ void F77_c3chke(char * rout
5655
}
5756
#endif
5857

58+
link_xerbla = 0;
5959
if (strncmp( sf,"cblas_cgemmtr" ,13)==0) {
6060
cblas_rout = "cblas_cgemmtr" ;
6161

‎CBLAS/testing/c_d2chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_d2chke(char *rout
@@ -51,6 +50,7 @@ void F77_d2chke(char *rout
5150
}
5251
#endif
5352

53+
link_xerbla = 0;
5454
cblas_ok = TRUE ;
5555
cblas_lerr = PASSED ;
5656

‎CBLAS/testing/c_d3chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_d3chke(char *rout
@@ -51,6 +50,7 @@ void F77_d3chke(char *rout
5150
}
5251
#endif
5352

53+
link_xerbla = 0;
5454
cblas_ok = TRUE ;
5555
cblas_lerr = PASSED ;
5656

‎CBLAS/testing/c_dblat3.f‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -84,10 +84,10 @@ PROGRAM DBLAT3
8484
INTRINSIC MAX, MIN
8585
* .. Scalars in Common ..
8686
INTEGER INFOT, NOUTC
87-
LOGICAL OK
87+
LOGICAL LERR, OK
8888
CHARACTER*13 SRNAMT
8989
* .. Common blocks ..
90-
COMMON /INFOC/INFOT, NOUTC, OK
90+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
9191
COMMON /SRNAMC/SRNAMT
9292
* .. Data statements ..
9393
DATA SNAMES/'cblas_dgemm ', 'cblas_dsymm ',
@@ -365,14 +365,14 @@ PROGRAM DBLAT3
365365
185 IF (CORDER) THEN
366366
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
367367
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
368-
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
369-
$ 0 )
368+
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
369+
$ CC, CS, CT, G, 0 )
370370
END IF
371371
IF (RORDER) THEN
372372
CALL DCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
373373
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
374-
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
375-
$ 1 )
374+
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
375+
$ CC, CS, CT, G, 1 )
376376
END IF
377377
GO TO 190
378378

@@ -478,9 +478,9 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
478478
INTRINSIC MAX
479479
* .. Scalars in Common ..
480480
INTEGER INFOT, NOUTC
481-
LOGICAL OK
481+
LOGICAL LERR, OK
482482
* .. Common blocks ..
483-
COMMON /INFOC/INFOT, NOUTC, OK
483+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
484484
* .. Data statements ..
485485
DATA ICH/'NTC'/
486486
* .. Executable Statements ..
@@ -802,9 +802,9 @@ SUBROUTINE DCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
802802
INTRINSIC MAX
803803
* .. Scalars in Common ..
804804
INTEGER INFOT, NOUTC
805-
LOGICAL OK
805+
LOGICAL LERR, OK
806806
* .. Common blocks ..
807-
COMMON /INFOC/INFOT, NOUTC, OK
807+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
808808
* .. Data statements ..
809809
DATA ICHS/'LR'/, ICHU/'UL'/
810810
* .. Executable Statements ..
@@ -1113,9 +1113,9 @@ SUBROUTINE DCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
11131113
INTRINSIC MAX
11141114
* .. Scalars in Common ..
11151115
INTEGER INFOT, NOUTC
1116-
LOGICAL OK
1116+
LOGICAL LERR, OK
11171117
* .. Common blocks ..
1118-
COMMON /INFOC/INFOT, NOUTC, OK
1118+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
11191119
* .. Data statements ..
11201120
DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
11211121
* .. Executable Statements ..
@@ -1472,9 +1472,9 @@ SUBROUTINE DCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
14721472
INTRINSIC MAX
14731473
* .. Scalars in Common ..
14741474
INTEGER INFOT, NOUTC
1475-
LOGICAL OK
1475+
LOGICAL LERR, OK
14761476
* .. Common blocks ..
1477-
COMMON /INFOC/INFOT, NOUTC, OK
1477+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
14781478
* .. Data statements ..
14791479
DATA ICHT/'NTC'/, ICHU/'UL'/
14801480
* .. Executable Statements ..
@@ -1789,9 +1789,9 @@ SUBROUTINE DCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
17891789
INTRINSIC MAX
17901790
* .. Scalars in Common ..
17911791
INTEGER INFOT, NOUTC
1792-
LOGICAL OK
1792+
LOGICAL LERR, OK
17931793
* .. Common blocks ..
1794-
COMMON /INFOC/INFOT, NOUTC, OK
1794+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
17951795
* .. Data statements ..
17961796
DATA ICHT/'NTC'/, ICHU/'UL'/
17971797
* .. Executable Statements ..

‎CBLAS/testing/c_s2chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_s2chke(char *rout
@@ -51,6 +50,7 @@ void F77_s2chke(char *rout
5150
}
5251
#endif
5352

53+
link_xerbla = 0;
5454
cblas_ok = TRUE ;
5555
cblas_lerr = PASSED ;
5656

‎CBLAS/testing/c_s3chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029

3130
}
3231

@@ -52,6 +51,7 @@ void F77_s3chke(char *rout
5251
}
5352
#endif
5453

54+
link_xerbla = 0;
5555
cblas_ok = TRUE ;
5656
cblas_lerr = PASSED ;
5757

‎CBLAS/testing/c_sblat3.f‎

Lines changed: 16 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -85,10 +85,10 @@ PROGRAM SBLAT3
8585
INTRINSIC MAX, MIN
8686
* .. Scalars in Common ..
8787
INTEGER INFOT, NOUTC
88-
LOGICAL OK
88+
LOGICAL LERR, OK
8989
CHARACTER*13 SRNAMT
9090
* .. Common blocks ..
91-
COMMON /INFOC/INFOT, NOUTC, OK
91+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
9292
COMMON /SRNAMC/SRNAMT
9393
* .. Data statements ..
9494
DATA SNAMES/'cblas_sgemm ', 'cblas_ssymm ',
@@ -365,15 +365,14 @@ PROGRAM SBLAT3
365365
185 IF (CORDER) THEN
366366
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
367367
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
368-
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
369-
$ 0 )
370-
368+
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
369+
$ CC, CS, CT, G, 0 )
371370
END IF
372371
IF (RORDER) THEN
373372
CALL SCHK6( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
374373
$ REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
375-
$ NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
376-
$ 1 )
374+
$ NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
375+
$ CC, CS, CT, G, 1 )
377376
END IF
378377
GO TO 190
379378
*
@@ -480,9 +479,9 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
480479
INTRINSIC MAX
481480
* .. Scalars in Common ..
482481
INTEGER INFOT, NOUTC
483-
LOGICAL OK
482+
LOGICAL LERR, OK
484483
* .. Common blocks ..
485-
COMMON /INFOC/INFOT, NOUTC, OK
484+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
486485
* .. Data statements ..
487486
DATA ICH/'NTC'/
488487
* .. Executable Statements ..
@@ -808,9 +807,9 @@ SUBROUTINE SCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
808807
INTRINSIC MAX
809808
* .. Scalars in Common ..
810809
INTEGER INFOT, NOUTC
811-
LOGICAL OK
810+
LOGICAL LERR, OK
812811
* .. Common blocks ..
813-
COMMON /INFOC/INFOT, NOUTC, OK
812+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
814813
* .. Data statements ..
815814
DATA ICHS/'LR'/, ICHU/'UL'/
816815
* .. Executable Statements ..
@@ -1119,9 +1118,9 @@ SUBROUTINE SCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
11191118
INTRINSIC MAX
11201119
* .. Scalars in Common ..
11211120
INTEGER INFOT, NOUTC
1122-
LOGICAL OK
1121+
LOGICAL LERR, OK
11231122
* .. Common blocks ..
1124-
COMMON /INFOC/INFOT, NOUTC, OK
1123+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
11251124
* .. Data statements ..
11261125
DATA ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
11271126
* .. Executable Statements ..
@@ -1479,9 +1478,9 @@ SUBROUTINE SCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
14791478
INTRINSIC MAX
14801479
* .. Scalars in Common ..
14811480
INTEGER INFOT, NOUTC
1482-
LOGICAL OK
1481+
LOGICAL LERR, OK
14831482
* .. Common blocks ..
1484-
COMMON /INFOC/INFOT, NOUTC, OK
1483+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
14851484
* .. Data statements ..
14861485
DATA ICHT/'NTC'/, ICHU/'UL'/
14871486
* .. Executable Statements ..
@@ -1796,9 +1795,9 @@ SUBROUTINE SCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
17961795
INTRINSIC MAX
17971796
* .. Scalars in Common ..
17981797
INTEGER INFOT, NOUTC
1799-
LOGICAL OK
1798+
LOGICAL LERR, OK
18001799
* .. Common blocks ..
1801-
COMMON /INFOC/INFOT, NOUTC, OK
1800+
COMMON /INFOC/INFOT, NOUTC, OK, LERR
18021801
* .. Data statements ..
18031802
DATA ICHT/'NTC'/, ICHU/'UL'/
18041803
* .. Executable Statements ..

‎CBLAS/testing/c_xerbla.c‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -103,7 +103,7 @@ void F77_xerbla(char *srname, void *vinfo
103103
char *srname;
104104
#endif
105105

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

108108
#ifdef F77_Integer
109109
F77_Integer *info=vinfo;
@@ -124,8 +124,12 @@ void F77_xerbla(char *srname, void *vinfo
124124
link_xerbla = 0;
125125
return;
126126
}
127-
for(i=0; i < 7; i++) rout[i+6] = tolower(srname[i]);
128-
for(i=12; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
127+
#ifndef BLAS_FORTRAN_STRLEN_END
128+
const int srname_len = 6;
129+
#endif
130+
131+
for(i=0; i < srname_len; i++) rout[i+6] = tolower(srname[i]);
132+
for(i=13; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
129133

130134
/* We increment *info by 1 since the CBLAS interface adds one more
131135
* argument to all level 2 and 3 routines.

‎CBLAS/testing/c_z2chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ void chkxer(void) {
2626
cblas_ok = 0 ;
2727
}
2828
cblas_lerr = 1 ;
29-
link_xerbla = TRUE;
3029
}
3130

3231
void F77_z2chke(char *rout
@@ -53,6 +52,7 @@ void F77_z2chke(char *rout
5352
}
5453
#endif
5554

55+
link_xerbla = 0;
5656
cblas_ok = TRUE ;
5757
cblas_lerr = PASSED ;
5858

0 commit comments

Comments
 (0)