From 992ea2dab54765ec3a34d3d77da1607f8ec2b00d Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:53:18 +0800
Subject: [PATCH 01/15] cmake: preserve callback typedefs in generated CBLAS
 headers

---
 CMakeLists.txt | 46 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 37 insertions(+), 9 deletions(-)

diff --git a/CMakeLists.txt b/CMakeLists.txt
index c88d9dd3e1..27aeae1e26 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -734,18 +734,46 @@ if(NOT NO_CBLAS)
   set(CBLAS_H ${CMAKE_BINARY_DIR}/generated/cblas.h)
   file(READ ${CMAKE_CURRENT_SOURCE_DIR}/cblas.h CBLAS_H_CONTENTS)
   string(REPLACE "common" "openblas_config" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
+
+  # Symbol prefix/suffix settings rename exported functions, not C typedefs.
+  # Protect callback type names from the textual function-name rewriting below.
+  string(REPLACE "openblas_dojob_callback" "OPENBLAS_DOJOB_CALLBACK_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "openblas_threads_callback" "OPENBLAS_THREADS_CALLBACK_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "openblas_xerbla_handler" "OPENBLAS_XERBLA_HANDLER_TYPE"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+
   if (NOT ${SYMBOLPREFIX} STREQUAL "")
-    string(REPLACE " cblas" " ${SYMBOLPREFIX}cblas" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REPLACE " openblas" " ${SYMBOLPREFIX}openblas" CBLAS_H_CONTENTS_NEW	"${CBLAS_H_CONTENTS}")
-    string (REPLACE " ${SYMBOLPREFIX}openblas_complex" " openblas_complex" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REPLACE " goto" " ${SYMBOLPREFIX}goto" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
+    string(REPLACE " cblas" " ${SYMBOLPREFIX}cblas"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " openblas" " ${SYMBOLPREFIX}openblas"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " ${SYMBOLPREFIX}openblas_complex" " openblas_complex"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE " goto" " ${SYMBOLPREFIX}goto"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
   endif()
   if (NOT ${SYMBOLSUFFIX} STREQUAL "")
-    string(REGEX REPLACE "(cblas[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REGEX REPLACE "(openblas[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS}")
-    string(REGEX REPLACE "(openblas_complex[^ ]*)${SYMBOLSUFFIX}" "\\1" CBLAS_H_CONTENTS	"${CBLAS_H_CONTENTS_NEW}")
-    string(REGEX REPLACE "(goto[^ (]*)" "\\1${SYMBOLSUFFIX}" CBLAS_H_CONTENTS_NEW	"${CBLAS_H_CONTENTS}")
-  endif()
+    string(REGEX REPLACE "(cblas[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(openblas[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REPLACE "openblas_config${SYMBOLSUFFIX}" "openblas_config"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(openblas_complex[A-Za-z0-9_]*)${SYMBOLSUFFIX}" "\\1"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+    string(REGEX REPLACE "(goto[A-Za-z0-9_]*)" "\\1${SYMBOLSUFFIX}"
+      CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  endif()
+
+  string(REPLACE "OPENBLAS_DOJOB_CALLBACK_TYPE" "openblas_dojob_callback"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "OPENBLAS_THREADS_CALLBACK_TYPE" "openblas_threads_callback"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+  string(REPLACE "OPENBLAS_XERBLA_HANDLER_TYPE" "openblas_xerbla_handler"
+    CBLAS_H_CONTENTS_NEW "${CBLAS_H_CONTENTS_NEW}")
+
   file(WRITE ${CBLAS_H} "${CBLAS_H_CONTENTS_NEW}")
   install (FILES ${CBLAS_H} DESTINATION ${CMAKE_INSTALL_INCLUDEDIR})
 endif()

From b2ba228de5af974e3e4649aaf0d1c05bd7f3c757 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:54:02 +0800
Subject: [PATCH 02/15] install: preserve callback typedefs in generated CBLAS
 headers

---
 Makefile.install | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/Makefile.install b/Makefile.install
index e656b368a8..cbeab53f81 100644
--- a/Makefile.install
+++ b/Makefile.install
@@ -73,7 +73,10 @@ install : 	lib.grd
 
 ifneq ($(NO_CBLAS),1)
 	@echo Generating cblas.h in $(DESTDIR)$(OPENBLAS_INCLUDE_DIR)
-	@cp cblas.h cblas.tmp
+	@sed -e 's/openblas_dojob_callback/OPENBLAS_DOJOB_CALLBACK_TYPE/g' \
+	     -e 's/openblas_threads_callback/OPENBLAS_THREADS_CALLBACK_TYPE/g' \
+	     -e 's/openblas_xerbla_handler/OPENBLAS_XERBLA_HANDLER_TYPE/g' \
+	     cblas.h > cblas.tmp
 ifdef SYMBOLPREFIX
 	@sed 's/cblas[^() ]*/$(SYMBOLPREFIX)&/g' cblas.tmp > cblas.tmp2
 	@sed 's/openblas[^() ]*/$(SYMBOLPREFIX)&/g'  cblas.tmp2 > cblas.tmp
@@ -88,7 +91,11 @@ ifdef SYMBOLSUFFIX
 	@sed 's/\(openblas_complex_\)\([^ ]*\)$(SYMBOLSUFFIX)/\1\2 /g'  cblas.tmp > cblas.tmp2
 	@sed 's/goto[^() ]*/&$(SYMBOLSUFFIX)/g'  cblas.tmp2 > cblas.tmp
 endif
-	@sed 's/common/openblas_config/g' cblas.tmp > "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)/cblas.h"
+	@sed -e 's/OPENBLAS_DOJOB_CALLBACK_TYPE/openblas_dojob_callback/g' \
+	     -e 's/OPENBLAS_THREADS_CALLBACK_TYPE/openblas_threads_callback/g' \
+	     -e 's/OPENBLAS_XERBLA_HANDLER_TYPE/openblas_xerbla_handler/g' \
+	     -e 's/common/openblas_config/g' \
+	     cblas.tmp > "$(DESTDIR)$(OPENBLAS_INCLUDE_DIR)/cblas.h"
 endif
 
 ifneq ($(OSNAME), AIX)

From 6a04925804565b45d78fabd02df8a36ff54708b9 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:55:52 +0800
Subject: [PATCH 03/15] xerbla: add a portable handler API

---
 cblas.h                | 12 ++++++++
 common.h               | 20 +++++++++++++
 driver/others/xerbla.c | 68 ++++++++++++++++++++++++++++++++----------
 3 files changed, 85 insertions(+), 15 deletions(-)

diff --git a/cblas.h b/cblas.h
index 8395f1b8b2..3d4143256b 100644
--- a/cblas.h
+++ b/cblas.h
@@ -59,6 +59,18 @@ typedef void (*openblas_dojob_callback)(int thread_num, void *jobdata, int dojob
 typedef void (*openblas_threads_callback)(int sync, openblas_dojob_callback dojob, int numjobs, size_t jobdata_elsize, void *jobdata, int dojob_data);
 void openblas_set_threads_callback_function(openblas_threads_callback callback);
 
+/* Set the process-wide error handler called by XERBLA. The callback's routine
+ * name is valid for name_length bytes and is not necessarily NUL-terminated.
+ * Installation is thread-safe, returns the previous handler, and accepts NULL
+ * to restore OpenBLAS' default handler. */
+#ifndef OPENBLAS_XERBLA_HANDLER_DEFINED
+#define OPENBLAS_XERBLA_HANDLER_DEFINED
+typedef void (*openblas_xerbla_handler)(const char *name,
+                                        const blasint *info,
+                                        size_t name_length);
+#endif
+openblas_xerbla_handler openblas_set_xerbla(openblas_xerbla_handler handler);
+
 #ifdef OPENBLAS_OS_LINUX
 /* Sets thread affinity for OpenBLAS threads. `thread_idx` is in [0, openblas_get_num_threads()-1]. */
 int openblas_setaffinity(int thread_idx, size_t cpusetsize, cpu_set_t* cpu_set);
diff --git a/common.h b/common.h
index a611c9cb07..336cb298e4 100644
--- a/common.h
+++ b/common.h
@@ -880,6 +880,26 @@ typedef struct {
 #endif
 
 #include "common_interface.h"
+
+/* Internal declaration of the public C XERBLA callback API. Keep this out of
+ * common_interface.h, whose contents are copied verbatim into f77blas.h and
+ * are not adjusted for SYMBOLPREFIX/SYMBOLSUFFIX by the CMake build. */
+#ifndef ASSEMBLER
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifndef OPENBLAS_XERBLA_HANDLER_DEFINED
+#define OPENBLAS_XERBLA_HANDLER_DEFINED
+typedef void (*openblas_xerbla_handler)(const char *name,
+                                        const blasint *info,
+                                        size_t name_length);
+#endif
+openblas_xerbla_handler openblas_set_xerbla(openblas_xerbla_handler handler);
+#ifdef __cplusplus
+}
+#endif
+#endif
+
 #ifdef SANITY_CHECK
 #include "common_reference.h"
 #endif
diff --git a/driver/others/xerbla.c b/driver/others/xerbla.c
index 290f2833c3..c7cc69b82b 100644
--- a/driver/others/xerbla.c
+++ b/driver/others/xerbla.c
@@ -36,8 +36,10 @@
 /* or implied, of The University of Texas at Austin.                 */
 /*********************************************************************/
 
+#include <limits.h>
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "common.h"
 
 #if defined(OS_WINDOWS) && (defined(__MINGW32__) || defined(__MINGW64__))
@@ -46,31 +48,67 @@
 #define printf	_cprintf
 #endif
 
-#ifdef INTERFACE64
-#define MSGFMT " ** On entry to %6s parameter number %2ld had an illegal value\n" 
-#else
-#define MSGFMT " ** On entry to %6s parameter number %2d had an illegal value\n"
-#endif
+#define MSGFMT " ** On entry to %6.*s parameter number %2lld had an illegal value\n"
 
-#ifdef __ELF__
-int __xerbla(char *message, blasint *info, blasint length){
+static size_t openblas_xerbla_name_length(const char *message,
+                                          blasint length) {
+  const char *terminator;
 
-  printf(MSGFMT,
-	  message, *info);
+  if (message == NULL || length <= 0) return 0;
 
-  return 0;
+  terminator = memchr(message, '\0', (size_t)length);
+  if (terminator != NULL) return (size_t)(terminator - message);
+
+  return (size_t)length;
 }
 
-int BLASFUNC(xerbla)(char *, blasint *, blasint) __attribute__ ((weak, alias ("__xerbla")));
+static void openblas_xerbla_default(const char *message, const blasint *info,
+                                    size_t length) {
+  int precision = length > INT_MAX ? INT_MAX : (int)length;
 
-#else
+  printf(MSGFMT, precision, message == NULL ? "" : message,
+         (long long)*info);
+}
+
+static openblas_xerbla_handler openblas_xerbla = openblas_xerbla_default;
+static volatile BLASULONG openblas_xerbla_lock = 0;
+
+openblas_xerbla_handler
+openblas_set_xerbla(openblas_xerbla_handler handler) {
+  openblas_xerbla_handler previous;
 
-int BLASFUNC(xerbla)(char *message, blasint *info, blasint length){
+  if (handler == NULL) handler = openblas_xerbla_default;
 
-  printf(MSGFMT,
-	  message, *info);
+  blas_lock(&openblas_xerbla_lock);
+  previous = openblas_xerbla;
+  openblas_xerbla = handler;
+  blas_unlock(&openblas_xerbla_lock);
 
+  return previous;
+}
+
+static int openblas_xerbla_dispatch(char *message, blasint *info,
+                                    blasint length) {
+  openblas_xerbla_handler handler;
+  size_t name_length = openblas_xerbla_name_length(message, length);
+
+  blas_lock(&openblas_xerbla_lock);
+  handler = openblas_xerbla;
+  blas_unlock(&openblas_xerbla_lock);
+
+  handler(message, info, name_length);
   return 0;
 }
 
+#ifdef __ELF__
+int __xerbla(char *message, blasint *info, blasint length) {
+  return openblas_xerbla_dispatch(message, info, length);
+}
+
+int BLASFUNC(xerbla)(char *, blasint *, blasint)
+  __attribute__ ((weak, alias ("__xerbla")));
+#else
+int BLASFUNC(xerbla)(char *message, blasint *info, blasint length) {
+  return openblas_xerbla_dispatch(message, info, length);
+}
 #endif

From 8da645954b5539eb56cc430ae74bb8fd5cbecf9a Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:56:48 +0800
Subject: [PATCH 04/15] exports: expose the XERBLA handler setter

---
 exports/gensymbol    | 1 +
 exports/gensymbol.pl | 1 +
 2 files changed, 2 insertions(+)

diff --git a/exports/gensymbol b/exports/gensymbol
index 6284e6b6ae..921aa60eab 100755
--- a/exports/gensymbol
+++ b/exports/gensymbol
@@ -182,6 +182,7 @@ misc_no_underscore_objs="
     openblas_get_config
     openblas_get_corename
     openblas_set_threads_callback_function
+    openblas_set_xerbla
 "
 
 misc_underscore_objs=""
diff --git a/exports/gensymbol.pl b/exports/gensymbol.pl
index 85a6e9dbf5..0fdaabc225 100644
--- a/exports/gensymbol.pl
+++ b/exports/gensymbol.pl
@@ -178,6 +178,7 @@
     openblas_get_config,
     openblas_get_corename,
     openblas_set_threads_callback_function,
+    openblas_set_xerbla,
 );
 
 @misc_underscore_objs = (

From d7e007e0fb016b883140fcc2d196958c1f1dd888 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:58:35 +0800
Subject: [PATCH 05/15] docs: document XERBLA handler semantics

---
 docs/extensions.md | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/docs/extensions.md b/docs/extensions.md
index 30db9895d1..fb2dd9c805 100644
--- a/docs/extensions.md
+++ b/docs/extensions.md
@@ -47,3 +47,8 @@ BLAS-like and conversion functions for `hfloat16` (available when OpenBLAS was c
 * `int openblas_set_affinity(int thread_index, size_t cpusetsize, cpu_set_t *cpuset)` sets the CPU affinity mask of the given thread
   to the provided cpuset. Only available on Linux, with semantics identical to `pthread_setaffinity_np`.
 * `openblas_set_thread_callback_function` overrides the default multithreading backend with the provided argument
+* `openblas_set_xerbla(openblas_xerbla_handler handler)` installs a process-wide XERBLA error handler and returns the previous one.
+  Installation is thread-safe, and passing `NULL` restores the default handler. The callback receives a read-only routine name,
+  error parameter number and normalized name length (excluding a terminating NUL when present); the name is not guaranteed to be
+  NUL-terminated. On ELF platforms, a legacy strong `xerbla` definition still takes precedence over this dispatcher. Callback code
+  must remain loaded until the handler has been replaced and all concurrent BLAS calls have completed.

From 29703e52ad07310bf61407a86b1d5f25821fff44 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 14:59:30 +0800
Subject: [PATCH 06/15] utest: cover explicit XERBLA handler registration

---
 utest/test_extensions/common.h |  1 -
 utest/test_extensions/xerbla.c | 56 ++++++++++++++++++++++------------
 2 files changed, 36 insertions(+), 21 deletions(-)

diff --git a/utest/test_extensions/common.h b/utest/test_extensions/common.h
index f8c60d2686..c7de83cd77 100644
--- a/utest/test_extensions/common.h
+++ b/utest/test_extensions/common.h
@@ -45,7 +45,6 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 extern int check_error(void);
 extern void set_xerbla(char* current_rout, int expected_info);
-extern int BLASFUNC(xerbla)(char *name, blasint *info, blasint length);
 
 extern void srand_generate(float *alpha, blasint n);
 extern void drand_generate(double *alpha, blasint n);
diff --git a/utest/test_extensions/xerbla.c b/utest/test_extensions/xerbla.c
index 8c90d4ce75..046a8c74c7 100644
--- a/utest/test_extensions/xerbla.c
+++ b/utest/test_extensions/xerbla.c
@@ -31,41 +31,55 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 **********************************************************************************/
 
+#include "utest/openblas_utest.h"
 #include "common.h"
 
-static int link_xerbla=TRUE;
+static int handler_installed = FALSE;
 static int lerr, _info, ok;
 static char *rout;
 
-static void F77_xerbla(char *srname, void *vinfo)
+static void test_xerbla(const char *srname, const blasint *vinfo, size_t length)
 {
-   blasint info=*(blasint*)vinfo;
+   blasint info = *vinfo;
 
-   if (link_xerbla)
-   {
-      link_xerbla = 0;
-      return;
-   }
-
-   if (rout != NULL && strcmp(rout, srname) != 0){
-      printf("***** XERBLA WAS CALLED WITH SRNAME = <%s> INSTEAD OF <%s> *******\n", srname, rout);
+   if (rout != NULL &&
+       (length != strlen(rout) || memcmp(rout, srname, length) != 0)) {
+      printf("***** XERBLA WAS CALLED WITH AN UNEXPECTED SRNAME INSTEAD OF <%s> *******\n",
+             rout);
       ok = FALSE;
    }
 
    if (info != _info){
-      printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, _info, srname);
+      printf("***** XERBLA WAS CALLED WITH INFO = %lld INSTEAD OF %d in %s *******\n",
+             (long long)info, _info, srname);
       lerr = TRUE;
       ok = FALSE;
    } else lerr = FALSE;
 }
 
-/**  
-* error function redefinition 
-*/
-int BLASFUNC(xerbla)(char *name, blasint *info, blasint length)
+static void alternate_xerbla(const char *srname, const blasint *vinfo,
+                             size_t length)
+{
+   (void) srname;
+   (void) vinfo;
+   (void) length;
+}
+
+CTEST(openblas_extensions, xerbla_handler_registration)
 {
-  F77_xerbla(name, info);
-  return 0;
+   openblas_xerbla_handler original;
+   openblas_xerbla_handler previous;
+   openblas_xerbla_handler restored;
+   openblas_xerbla_handler default_handler;
+
+   original = openblas_set_xerbla(test_xerbla);
+   previous = openblas_set_xerbla(alternate_xerbla);
+   restored = openblas_set_xerbla(NULL);
+   default_handler = openblas_set_xerbla(original);
+
+   ASSERT_TRUE(previous == test_xerbla);
+   ASSERT_TRUE(restored == alternate_xerbla);
+   ASSERT_TRUE(default_handler != NULL);
 }
 
 int check_error(void) {
@@ -78,8 +92,10 @@ int check_error(void) {
 }
 
 void set_xerbla(char* current_rout, int expected_info){
-   if (link_xerbla) /* call these first to link */
-      F77_xerbla(rout, &_info);
+   if (!handler_installed) {
+      openblas_set_xerbla(test_xerbla);
+      handler_installed = TRUE;
+   }
 
    ok = TRUE;
    lerr = TRUE;

From 99bb32ae596600646ce2cda92f1d1f0f0c4759e9 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:00:36 +0800
Subject: [PATCH 07/15] ctest: use explicit XERBLA handlers in error tests

---
 ctest/c_c2chke.c    | 17 +++----------
 ctest/c_c3chke.c    | 17 +++----------
 ctest/c_c3chke_3m.c | 17 +++----------
 ctest/c_d2chke.c    | 17 +++----------
 ctest/c_d3chke.c    | 17 +++----------
 ctest/c_s2chke.c    | 17 +++----------
 ctest/c_s3chke.c    | 17 +++----------
 ctest/c_xerbla.c    | 61 +++++++++++----------------------------------
 ctest/c_z2chke.c    | 17 +++----------
 ctest/c_z3chke.c    | 17 +++----------
 ctest/c_z3chke_3m.c | 17 +++----------
 ctest/cblas_test.h  |  2 ++
 12 files changed, 46 insertions(+), 187 deletions(-)

diff --git a/ctest/c_c2chke.c b/ctest/c_c2chke.c
index eb5b99008f..fe982f336d 100644
--- a/ctest/c_c2chke.c
+++ b/ctest/c_c2chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -36,11 +29,7 @@ void F77_c2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_c3chke.c b/ctest/c_c3chke.c
index 3b4764c4a7..b55ef501eb 100644
--- a/ctest/c_c3chke.c
+++ b/ctest/c_c3chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_c3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
    if (strncmp( sf,"cblas_cgemm"   ,11)==0) {
diff --git a/ctest/c_c3chke_3m.c b/ctest/c_c3chke_3m.c
index 4d5de5150c..782e869ca6 100644
--- a/ctest/c_c3chke_3m.c
+++ b/ctest/c_c3chke_3m.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_c3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
    if (strncmp( sf,"cblas_cgemm3m"   ,13)==0) {
diff --git a/ctest/c_d2chke.c b/ctest/c_d2chke.c
index 7cdd04135c..dde71323d5 100644
--- a/ctest/c_d2chke.c
+++ b/ctest/c_d2chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_d2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_d3chke.c b/ctest/c_d3chke.c
index 700cff28f6..29a5316eec 100644
--- a/ctest/c_d3chke.c
+++ b/ctest/c_d3chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_d3chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_s2chke.c b/ctest/c_s2chke.c
index 1455153005..8e1d739006 100644
--- a/ctest/c_s2chke.c
+++ b/ctest/c_s2chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_s2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_s3chke.c b/ctest/c_s3chke.c
index 632eaae30e..ab4034c931 100644
--- a/ctest/c_s3chke.c
+++ b/ctest/c_s3chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -34,11 +27,7 @@ void F77_s3chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_xerbla.c b/ctest/c_xerbla.c
index 9c53576536..67d62701f1 100644
--- a/ctest/c_xerbla.c
+++ b/ctest/c_xerbla.c
@@ -8,17 +8,9 @@
 void cblas_xerbla(blasint info, char *rout, char *form, ...)
 {
    extern int cblas_lerr, cblas_info, cblas_ok;
-   extern int link_xerbla;
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   /* Initially, c__3chke will 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
-    * instead of ones in the CBLAS or the legacy BLAS library.
-    */
-   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);
       cblas_ok = FALSE;
@@ -78,44 +70,27 @@ void cblas_xerbla(blasint info, char *rout, char *form, ...)
    }
 
    if (info != cblas_info){
-      printf("***** XERBLA WAS CALLED WITH INFO = %d INSTEAD OF %d in %s *******\n",info, cblas_info, rout);
+      printf("***** XERBLA WAS CALLED WITH INFO = %lld INSTEAD OF %lld in %s *******\n",
+             (long long)info, (long long)cblas_info, rout);
       cblas_lerr = PASSED;
       cblas_ok = FALSE;
    } 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
+static void cblas_test_xerbla(const char *srname, const blasint *info,
+                              size_t length)
 {
-#ifdef F77_Char
-   char *srname;
-#endif
-
+   extern int cblas_ok;
    char rout[] = {'c','b','l','a','s','_','\0','\0','\0','\0','\0','\0','\0'};
+   blasint i;
 
-#ifdef F77_Integer
-   F77_Integer *info=vinfo;
-   F77_Integer i;
-   extern F77_Integer link_xerbla;
-#else
-   int *info=vinfo;
-   int i;
-   extern int link_xerbla;
-#endif
-#ifdef F77_Char
-   srname = F2C_STR(F77_srname, XerblaStrLen);
-#endif
-
-   /* See the comment in cblas_xerbla() above */
-   if (link_xerbla)
-   {
-      link_xerbla = 0;
+   if (length < 6) {
+      printf("***** XERBLA WAS CALLED WITH AN INVALID ROUTINE NAME LENGTH *******\n");
+      cblas_ok = FALSE;
       return;
    }
-   for(i=0;  i  < 6; i++) rout[i+6] = tolower(srname[i]);
+
+   for(i=0;  i  < 6; i++) rout[i+6] = tolower((unsigned char)srname[i]);
    for(i=11; i >= 9; i--) if (rout[i] == ' ') rout[i] = '\0';
 
    /* We increment *info by 1 since the CBLAS interface adds one more
@@ -124,14 +99,6 @@ void F77_xerbla(char *srname, void *vinfo)
    cblas_xerbla(*info+1,rout,"");
 }
 
-#ifdef USE64BITINT
-#undef int
-#endif
-
-int    BLASFUNC(xerbla)(char *name, blasint *info, blasint length) {
-
-  F77_xerbla(name, info);
-  return 0;
-};
-
-
+void cblas_test_set_xerbla(void) {
+   openblas_set_xerbla(cblas_test_xerbla);
+}
diff --git a/ctest/c_z2chke.c b/ctest/c_z2chke.c
index 8767b5201a..e036e10a4e 100644
--- a/ctest/c_z2chke.c
+++ b/ctest/c_z2chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -36,11 +29,7 @@ void F77_z2chke(char *rout) {
    extern int RowMajorStrg;
    extern char *cblas_rout;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
diff --git a/ctest/c_z3chke.c b/ctest/c_z3chke.c
index 054e723603..3e11a91c01 100644
--- a/ctest/c_z3chke.c
+++ b/ctest/c_z3chke.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_z3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
 
diff --git a/ctest/c_z3chke_3m.c b/ctest/c_z3chke_3m.c
index 4be4457b41..3074837697 100644
--- a/ctest/c_z3chke_3m.c
+++ b/ctest/c_z3chke_3m.c
@@ -4,21 +4,14 @@
 #include "cblas_test.h"
 
 int cblas_ok, cblas_lerr, cblas_info;
-int link_xerbla=TRUE;
 char *cblas_rout;
 
-#ifdef F77_Char
-void F77_xerbla(F77_Char F77_srname, void *vinfo);
-#else
-void F77_xerbla(char *srname, void *vinfo);
-#endif
-
 void chkxer(void) {
    extern int cblas_ok, cblas_lerr, cblas_info;
-   extern int link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %lld NOT DETECTED BY %s *****\n",
+             (long long)cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
@@ -39,11 +32,7 @@ void  F77_z3chke(char *  rout) {
    cblas_ok = TRUE ;
    cblas_lerr = PASSED ;
 
-   if (link_xerbla) /* call these first to link */
-   {
-      cblas_xerbla(cblas_info,cblas_rout,"");
-      F77_xerbla(cblas_rout,&cblas_info);
-   }
+   cblas_test_set_xerbla();
 
 
 
diff --git a/ctest/cblas_test.h b/ctest/cblas_test.h
index 502a2fee20..426c68b8e5 100644
--- a/ctest/cblas_test.h
+++ b/ctest/cblas_test.h
@@ -30,6 +30,8 @@
 #define  INVALID       -1
 #define  UNDEFINED     -1
 
+void cblas_test_set_xerbla(void);
+
 typedef struct { float real; float imag; } CBLAS_TEST_COMPLEX;
 typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;
 

From 39526d88c9f7cd88030f5ae6411a263343b432f3 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:02:17 +0800
Subject: [PATCH 08/15] ctest: add a fatal test failure helper

---
 ctest/c_xerbla.c   | 5 +++++
 ctest/cblas_test.h | 1 +
 2 files changed, 6 insertions(+)

diff --git a/ctest/c_xerbla.c b/ctest/c_xerbla.c
index 67d62701f1..6f190b0c4b 100644
--- a/ctest/c_xerbla.c
+++ b/ctest/c_xerbla.c
@@ -1,4 +1,5 @@
 #include <stdio.h>
+#include <stdlib.h>
 #include <ctype.h>
 #include <stdarg.h>
 #include <string.h>
@@ -102,3 +103,7 @@ static void cblas_test_xerbla(const char *srname, const blasint *info,
 void cblas_test_set_xerbla(void) {
    openblas_set_xerbla(cblas_test_xerbla);
 }
+
+void cblas_test_fail(void) {
+   exit(EXIT_FAILURE);
+}
diff --git a/ctest/cblas_test.h b/ctest/cblas_test.h
index 426c68b8e5..9f86d0f5d7 100644
--- a/ctest/cblas_test.h
+++ b/ctest/cblas_test.h
@@ -31,6 +31,7 @@
 #define  UNDEFINED     -1
 
 void cblas_test_set_xerbla(void);
+void cblas_test_fail(void);
 
 typedef struct { float real; float imag; } CBLAS_TEST_COMPLEX;
 typedef struct { double real; double imag; } CBLAS_TEST_ZOMPLEX;

From cd4786dd78b38ff14522864fd4c430f72d76bb56 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:03:18 +0800
Subject: [PATCH 09/15] ctest: fail level-2 error-exit mismatches

---
 ctest/c_c2chke.c | 4 +++-
 ctest/c_d2chke.c | 4 +++-
 ctest/c_s2chke.c | 4 +++-
 ctest/c_z2chke.c | 4 +++-
 4 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/ctest/c_c2chke.c b/ctest/c_c2chke.c
index fe982f336d..2129aad3fa 100644
--- a/ctest/c_c2chke.c
+++ b/ctest/c_c2chke.c
@@ -810,6 +810,8 @@ void F77_c2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_d2chke.c b/ctest/c_d2chke.c
index dde71323d5..cb4ed8876a 100644
--- a/ctest/c_d2chke.c
+++ b/ctest/c_d2chke.c
@@ -773,6 +773,8 @@ void F77_d2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_s2chke.c b/ctest/c_s2chke.c
index 8e1d739006..69cf042c39 100644
--- a/ctest/c_s2chke.c
+++ b/ctest/c_s2chke.c
@@ -773,6 +773,8 @@ void F77_s2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_z2chke.c b/ctest/c_z2chke.c
index e036e10a4e..872b89fa8e 100644
--- a/ctest/c_z2chke.c
+++ b/ctest/c_z2chke.c
@@ -810,6 +810,8 @@ void F77_z2chke(char *rout) {
    }
    if (cblas_ok == TRUE)
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

From 5daa61827ab395ee4570323ccb2c184b548488d9 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:04:13 +0800
Subject: [PATCH 10/15] ctest: fail level-3 error-exit mismatches

---
 ctest/c_c3chke.c    | 4 +++-
 ctest/c_c3chke_3m.c | 4 +++-
 ctest/c_d3chke.c    | 4 +++-
 ctest/c_s3chke.c    | 4 +++-
 ctest/c_z3chke.c    | 4 +++-
 ctest/c_z3chke_3m.c | 4 +++-
 6 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/ctest/c_c3chke.c b/ctest/c_c3chke.c
index b55ef501eb..6b6b7684d9 100644
--- a/ctest/c_c3chke.c
+++ b/ctest/c_c3chke.c
@@ -1692,6 +1692,8 @@ void  F77_c3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_c3chke_3m.c b/ctest/c_c3chke_3m.c
index 782e869ca6..767d0cfeb2 100644
--- a/ctest/c_c3chke_3m.c
+++ b/ctest/c_c3chke_3m.c
@@ -1920,6 +1920,8 @@ void  F77_c3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_d3chke.c b/ctest/c_d3chke.c
index 29a5316eec..aff8380eb0 100644
--- a/ctest/c_d3chke.c
+++ b/ctest/c_d3chke.c
@@ -1255,6 +1255,8 @@ void F77_d3chke(char *rout) {
    }
    if (cblas_ok == TRUE )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_s3chke.c b/ctest/c_s3chke.c
index ab4034c931..c8eae8c400 100644
--- a/ctest/c_s3chke.c
+++ b/ctest/c_s3chke.c
@@ -1257,6 +1257,8 @@ void F77_s3chke(char *rout) {
    }
    if (cblas_ok == TRUE )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_z3chke.c b/ctest/c_z3chke.c
index 3e11a91c01..3bbb1ce10e 100644
--- a/ctest/c_z3chke.c
+++ b/ctest/c_z3chke.c
@@ -1694,6 +1694,8 @@ void  F77_z3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }
diff --git a/ctest/c_z3chke_3m.c b/ctest/c_z3chke_3m.c
index 3074837697..7834934f59 100644
--- a/ctest/c_z3chke_3m.c
+++ b/ctest/c_z3chke_3m.c
@@ -1924,6 +1924,8 @@ void  F77_z3chke(char *  rout) {
 
    if (cblas_ok == 1 )
        printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
-   else
+   else {
        printf("***** %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
+       cblas_test_fail();
+   }
 }

From 490721cbd9f290199ed48dae1e1bee17ce043957 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:33:44 +0800
Subject: [PATCH 11/15] exports: preserve Windows ordinals for new symbols

---
 exports/gensymbol | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/exports/gensymbol b/exports/gensymbol
index 921aa60eab..bd4652b0c0 100755
--- a/exports/gensymbol
+++ b/exports/gensymbol
@@ -4112,10 +4112,13 @@ case "$p1" in
         done
 
         for obj in $no_underscore_objs; do
+            [ "$obj" = "openblas_set_xerbla" ] && continue
             printf '\t%s%s%s=%s  @%s\n' \
                 "$symbolprefix" "$obj" "$symbolsuffix" "$obj" "$count"
             count=`expr $count + 1`
         done
+        printf '\t%sopenblas_set_xerbla%s=openblas_set_xerbla  @%s\n' \
+            "$symbolprefix" "$symbolsuffix" "$count"
     ;;
 
     win2khpl)

From f07e6a3d0d839c5d2dc5be590fffe01f4905e354 Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:39:22 +0800
Subject: [PATCH 12/15] exports: preserve Windows ordinals in Perl generator

---
 exports/gensymbol.pl | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/exports/gensymbol.pl b/exports/gensymbol.pl
index 0fdaabc225..72e30dff2d 100644
--- a/exports/gensymbol.pl
+++ b/exports/gensymbol.pl
@@ -4054,9 +4054,11 @@
 
 
     foreach $objs (@no_underscore_objs) {
+        next if $objs eq "openblas_set_xerbla";
         print "\t",$symbolprefix,$objs,$symbolsuffix,"=$objs","  \@", $count, "\n";
         $count ++;
     }
+    print "\t",$symbolprefix,"openblas_set_xerbla",$symbolsuffix,"=openblas_set_xerbla  \@",$count,"\n";
 
     exit(0);
 }

From ed8f1198b2a39b9f8ad1d40039f6831a4a10833a Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:40:02 +0800
Subject: [PATCH 13/15] utest: bound XERBLA routine name diagnostics

---
 utest/test_extensions/xerbla.c | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/utest/test_extensions/xerbla.c b/utest/test_extensions/xerbla.c
index 046a8c74c7..6d0b9f2de7 100644
--- a/utest/test_extensions/xerbla.c
+++ b/utest/test_extensions/xerbla.c
@@ -31,6 +31,7 @@ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 **********************************************************************************/
 
+#include <limits.h>
 #include "utest/openblas_utest.h"
 #include "common.h"
 
@@ -41,6 +42,7 @@ static char *rout;
 static void test_xerbla(const char *srname, const blasint *vinfo, size_t length)
 {
    blasint info = *vinfo;
+   int name_length = length > (size_t)INT_MAX ? INT_MAX : (int)length;
 
    if (rout != NULL &&
        (length != strlen(rout) || memcmp(rout, srname, length) != 0)) {
@@ -50,8 +52,8 @@ static void test_xerbla(const char *srname, const blasint *vinfo, size_t length)
    }
 
    if (info != _info){
-      printf("***** XERBLA WAS CALLED WITH INFO = %lld INSTEAD OF %d in %s *******\n",
-             (long long)info, _info, srname);
+      printf("***** XERBLA WAS CALLED WITH INFO = %lld INSTEAD OF %d in %.*s *******\n",
+             (long long)info, _info, name_length, srname == NULL ? "" : srname);
       lerr = TRUE;
       ok = FALSE;
    } else lerr = FALSE;

From d093ab90e9c71e47a7618374d35dfb2cc27a963c Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 15:54:19 +0800
Subject: [PATCH 14/15] docs: clarify XERBLA handler concurrency

---
 docs/extensions.md | 11 ++++++-----
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/docs/extensions.md b/docs/extensions.md
index fb2dd9c805..78efc5dc58 100644
--- a/docs/extensions.md
+++ b/docs/extensions.md
@@ -47,8 +47,9 @@ BLAS-like and conversion functions for `hfloat16` (available when OpenBLAS was c
 * `int openblas_set_affinity(int thread_index, size_t cpusetsize, cpu_set_t *cpuset)` sets the CPU affinity mask of the given thread
   to the provided cpuset. Only available on Linux, with semantics identical to `pthread_setaffinity_np`.
 * `openblas_set_thread_callback_function` overrides the default multithreading backend with the provided argument
-* `openblas_set_xerbla(openblas_xerbla_handler handler)` installs a process-wide XERBLA error handler and returns the previous one.
-  Installation is thread-safe, and passing `NULL` restores the default handler. The callback receives a read-only routine name,
-  error parameter number and normalized name length (excluding a terminating NUL when present); the name is not guaranteed to be
-  NUL-terminated. On ELF platforms, a legacy strong `xerbla` definition still takes precedence over this dispatcher. Callback code
-  must remain loaded until the handler has been replaced and all concurrent BLAS calls have completed.
+* `openblas_set_xerbla(openblas_xerbla_handler handler)` installs a process-wide XERBLA error handler and returns the previous handler.
+  Passing `NULL` restores the default handler. Handler replacement is thread-safe, but callbacks may run concurrently and must
+  therefore be thread-safe. The routine name and error information are valid only for the duration of the callback. The name is
+  valid for the supplied length, is not necessarily NUL-terminated, and retains any trailing spaces; when a NUL is present, the
+  reported length stops before the first NUL. Replacing a handler does not wait for callbacks already in progress. On ELF platforms,
+  a legacy strong `xerbla` definition takes precedence over this dispatcher.

From 97abc61bfc7257e9d750813b070141ae34dc1f2d Mon Sep 17 00:00:00 2001
From: moluopro <moluopro@qq.com>
Date: Fri, 10 Jul 2026 20:40:50 +0800
Subject: [PATCH 15/15] docs: clarify XERBLA handler behavior on ELF

---
 docs/extensions.md | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/docs/extensions.md b/docs/extensions.md
index 78efc5dc58..db7fad51ec 100644
--- a/docs/extensions.md
+++ b/docs/extensions.md
@@ -47,9 +47,10 @@ BLAS-like and conversion functions for `hfloat16` (available when OpenBLAS was c
 * `int openblas_set_affinity(int thread_index, size_t cpusetsize, cpu_set_t *cpuset)` sets the CPU affinity mask of the given thread
   to the provided cpuset. Only available on Linux, with semantics identical to `pthread_setaffinity_np`.
 * `openblas_set_thread_callback_function` overrides the default multithreading backend with the provided argument
-* `openblas_set_xerbla(openblas_xerbla_handler handler)` installs a process-wide XERBLA error handler and returns the previous handler.
-  Passing `NULL` restores the default handler. Handler replacement is thread-safe, but callbacks may run concurrently and must
-  therefore be thread-safe. The routine name and error information are valid only for the duration of the callback. The name is
-  valid for the supplied length, is not necessarily NUL-terminated, and retains any trailing spaces; when a NUL is present, the
-  reported length stops before the first NUL. Replacing a handler does not wait for callbacks already in progress. On ELF platforms,
-  a legacy strong `xerbla` definition takes precedence over this dispatcher.
+* `openblas_set_xerbla(openblas_xerbla_handler handler)` installs a process-wide XERBLA error handler and returns the
+  previous handler. Passing `NULL` restores the default handler. Handlers must be thread-safe because they may be called
+  concurrently. Replacing a handler is thread-safe but does not wait for in-progress calls to return, so the previous handler's
+  code must remain loaded until those calls finish. The `name` and `info` pointers are valid only during the callback. `name`
+  points to `name_length` valid bytes and need not be NUL-terminated; the length stops before the first NUL but otherwise includes
+  trailing spaces. Handler registration works normally on ELF platforms. For backward compatibility, an application-provided
+  strong `xerbla` symbol still overrides the OpenBLAS dispatcher and bypasses the registered handler.