Skip to content

Commit 426641c

Browse files
grisuthedragongrisuthedragon
committed
Fix wrong calls do dchk6 and schk6 and string length in xerbla
1 parent e3951fb commit 426641c

File tree

11 files changed

+48
-37
lines changed

11 files changed

+48
-37
lines changed

‎CBLAS/testing/c_c2chke.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -51,7 +51,7 @@ void F77_c2chke(char *rout
5151
F77_xerbla(cblas_rout,&cblas_info, 1);
5252
}
5353
#endif
54-
54+
link_xerbla = 0;
5555
cblas_ok = TRUE ;
5656
cblas_lerr = PASSED ;
5757

‎CBLAS/testing/c_c3chke.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,7 @@ void F77_c3chke(char * rout
5555
}
5656
#endif
5757

58+
link_xerbla = 0;
5859
if (strncmp( sf,"cblas_cgemmtr" ,13)==0) {
5960
cblas_rout = "cblas_cgemmtr" ;
6061

‎CBLAS/testing/c_d2chke.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ void F77_d2chke(char *rout
5050
}
5151
#endif
5252

53+
link_xerbla = 0;
5354
cblas_ok = TRUE ;
5455
cblas_lerr = PASSED ;
5556

‎CBLAS/testing/c_d3chke.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ void F77_d3chke(char *rout
5050
}
5151
#endif
5252

53+
link_xerbla = 0;
5354
cblas_ok = TRUE ;
5455
cblas_lerr = PASSED ;
5556

‎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 & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ void F77_s2chke(char *rout
5050
}
5151
#endif
5252

53+
link_xerbla = 0;
5354
cblas_ok = TRUE ;
5455
cblas_lerr = PASSED ;
5556

‎CBLAS/testing/c_s3chke.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ void F77_s3chke(char *rout
5151
}
5252
#endif
5353

54+
link_xerbla = 0;
5455
cblas_ok = TRUE ;
5556
cblas_lerr = PASSED ;
5657

‎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 & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -52,6 +52,7 @@ void F77_z2chke(char *rout
5252
}
5353
#endif
5454

55+
link_xerbla = 0;
5556
cblas_ok = TRUE ;
5657
cblas_lerr = PASSED ;
5758

0 commit comments

Comments
 (0)