master: Return constant string from NATURALIZE if length is 0

The branch "master" has been updated in SBCL:
       via  3991dc73d6871cd88558dee9aab0a37adb5cb18c (commit)
      from  aa2788ebf7b71599a2ad895799945358bf193b2c (commit)

- Log -----------------------------------------------------------------
commit 3991dc73d6871cd88558dee9aab0a37adb5cb18c
Author: Douglas Katzman <[email protected]>
Date:   Wed Jun 10 09:01:21 2026 -0400

    Return constant string from NATURALIZE if length is 0
---
 src/code/target-c-call.lisp | 27 +++++++++++++++------------
 tests/aliencall.pure.lisp   | 15 +++++++++++++--
 2 files changed, 28 insertions(+), 14 deletions(-)

diff --git a/src/code/target-c-call.lisp b/src/code/target-c-call.lisp
index c517663ed..0ce883a9e 100644
--- a/src/code/target-c-call.lisp
+++ b/src/code/target-c-call.lisp
@@ -52,6 +52,7 @@
       (setf *default-c-string-external-format*
             (sb-impl::default-external-format))))
 
+(with-alien ((strlen (function size-t system-area-pointer) :extern))
 (defun %naturalize-c-string (sap)
   (declare (type system-area-pointer sap))
   ;; It can be assumed that any modern implementation of strlen() reads 4, 8, 16,
@@ -63,18 +64,20 @@
   ;; Below that, it's about the same to do a foreign call versus staying in lisp.
   ;; The limiting case of a 0 length string would be faster without the foreign call,
   ;; but pre-checking would slow down every other case.
-  (let* ((length (alien-funcall
-                 (extern-alien "strlen" (function size-t system-area-pointer))
-                 sap))
-         (result (make-string length :element-type 'base-char)))
-    ;; COPY-UB8 pins the lisp string, no need to do it here
-    (sb-kernel:copy-ub8-from-system-area sap 0 result 0 length)
-    result))
+  (let ((length (alien-funcall strlen sap)))
+    (if (= length 0)
+        "" ; #\nul is not standard-char, but all cross-compiled strings are base-string
+        (let ((result (make-string length :element-type 'base-char)))
+          ;; COPY-UB8 pins the lisp string, no need to do it here
+          (sb-kernel:copy-ub8-from-system-area sap 0 result 0 length)
+          result))))
 
 (defun %naturalize-base-string/word (word)
   (declare (type sb-vm:word word))
-  (let* ((length (alien-funcall (extern-alien "strlen" (function size-t unsigned)) word))
-         (result (make-string length :element-type 'base-char)))
-    (with-pinned-objects (result)
-      (sb-impl::memcpy (vector-sap result) (int-sap word) length))
-    result))
+  (let ((length (alien-funcall strlen (int-sap word))))
+    (if (= length 0)
+        "" ; #\nul is not standard-char, but all cross-compiled strings are base-string
+        (let ((result (make-string length :element-type 'base-char)))
+          (with-pinned-objects (result)
+            (sb-impl::memcpy (vector-sap result) (int-sap word) length))
+          result)))))
diff --git a/tests/aliencall.pure.lisp b/tests/aliencall.pure.lisp
index 6b64a5b74..39f7ea213 100644
--- a/tests/aliencall.pure.lisp
+++ b/tests/aliencall.pure.lisp
@@ -40,10 +40,10 @@
     ;; 2) 60023FD6         BLR R9
     #+arm64 (assert (= (loop for line in lines count (search "BLR" line)) 2))))
 
+(define-alien-type ascii-string (c-string :external-format :ascii :element-type base-char))
 (locally
 (declare (optimize (sb-c::alien-funcall-saves-fp-and-pc 0)))
-(define-alien-routine strerror (c-string :external-format :ascii :element-type base-char)
-  (e int)))
+(define-alien-routine strerror ascii-string (e int)))
 
 (with-test (:name :return-c-string-optimizer :skipped-on (not (and :sb-unicode :x86-64)))
   ;; check that the thing actually works
@@ -55,3 +55,14 @@
     ;; no alloc-tramp (no SAP consing), nor BIGNUM consing
     (assert (loop for line in lines
                   never (or (search "ALLOC" line) (search "BIGNUM" line))))))
+
+;;; 0-length strings from an ASCII-STRING returned by a alien function
+;;; should all be EQ.  This is not a hard-and-fast rule but we try.
+(with-test (:name :0-length-const-string :skipped-on (not :sb-unicode))
+  (with-alien ((strcat (function ascii-string system-area-pointer system-area-pointer) :extern))
+    (let* ((str (make-alien-string ""))
+           (sap (alien-sap str))
+           (concatenation1 (alien-funcall strcat sap sap))
+           (concatenation2 (alien-funcall strcat sap sap)))
+      (assert (eq concatenation1 concatenation2))
+      (free-alien str))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL