master: Add utf8 strlen test

The branch "master" has been updated in SBCL:
       via  094a492c82d0194aee8077c32c22fbcb6b62d870 (commit)
      from  d6129e1920c793a9872defd020929a3e5d675fdc (commit)

- Log -----------------------------------------------------------------
commit 094a492c82d0194aee8077c32c22fbcb6b62d870
Author: Stas Boukarev <[email protected]>
Date:   Sat Jul 18 02:02:14 2026 +0300

    Add utf8 strlen test
---
 src/code/external-formats/enc-basic.lisp | 18 +++++++++++-------
 tests/utf-8.impure.lisp                  | 30 ++++++++++++++++++++++++++++--
 2 files changed, 39 insertions(+), 9 deletions(-)

diff --git a/src/code/external-formats/enc-basic.lisp b/src/code/external-formats/enc-basic.lisp
index 9bb693eed..3336c1ed7 100644
--- a/src/code/external-formats/enc-basic.lisp
+++ b/src/code/external-formats/enc-basic.lisp
@@ -698,6 +698,14 @@
             do (setf (aref string i)
                      (code-char (sap-ref-8 sap i)))))))
 
+#-(and sb-unicode 64-bit little-endian (or arm64 x86-64))
+(defun simd-copy-ascii-sap-to-character-string (sap string length)
+  (declare (index length)
+           (simple-character-string string)
+           (optimize speed (safety 0)))
+  (loop for i below length
+        do (setf (aref string i) (code-char (sap-ref-8 sap i)))))
+
 #+(and sb-unicode 64-bit little-endian)
 (defun sb-vm::simd-copy-utf8-crlf-to-character-string-with-size (start end string ibuf size-buffer)
   (declare (type index start end)
@@ -1620,15 +1628,11 @@
               (character (make-string char-length :element-type 'character))
               (t (make-string char-length :element-type element-type)))))
       (if all-ascii
-          (cond #+(and sb-unicode 64-bit little-endian)
-                ((typep string '(array character))
+          (cond ((typep string '(array character))
                  (sb-vm::simd-copy-ascii-sap-to-character-string sap string char-length))
-                ((typep string 'base-string)
+                (t
                  (with-pinned-objects (string)
-                   (sb-impl::memcpy (vector-sap string) sap char-length)))
-                (t
-                 (loop for i below char-length
-                       do (setf (aref string i) (code-char (sap-ref-8 sap i))))))
+                   (sb-impl::memcpy (vector-sap string) sap char-length))))
           (sb-vm::simd-copy-utf8-sap-to-character-string sap string byte-length))
       string)))
 
diff --git a/tests/utf-8.impure.lisp b/tests/utf-8.impure.lisp
index a3df61393..711ccce40 100644
--- a/tests/utf-8.impure.lisp
+++ b/tests/utf-8.impure.lisp
@@ -75,6 +75,9 @@
                                       (1 (+ 128 (random (- 2048 128))))
                                       (2 (+ 2048 (random (- 50000 2048))))
                                       (3 (+ 65536 (random (- char-code-limit 65536))))))))))
+(defun strlen (bytes)
+  (sb-vm::simd-utf8-strlen (sb-sys:vector-sap bytes)))
+(compile 'strlen)
 
 (with-test (:name :decode-test)
   (loop for length from 1 to 32
@@ -90,6 +93,29 @@
                                               string)))
                      (free-protected-array bytes))))))
 
+(with-test (:name :strlen-test)
+  (loop for length from 1 to 32
+        for string = (make-protected-array length 'character nil)
+        do
+        (loop repeat (* 500 #+slow 10)
+              do (fill-random-string string)
+                 (let* ((octets (sb-ext:string-to-octets string :null-terminate t))
+                        (octet-length (1- (length octets)))
+                        (bytes (make-protected-array (length octets) '(unsigned-byte 8) nil)))
+                   (unwind-protect
+                        (progn
+                          (replace bytes octets)
+                          (multiple-value-bind (strlen-chars strlen-bytes) (strlen bytes)
+                            (unless (or (and (= strlen-chars length)
+                                             (= strlen-bytes octet-length))
+                                        (find #\Nul string))
+                              (error "(strlen ~s) => ~a, ~a /= ~a, ~a" string strlen-chars strlen-bytes length octet-length)))
+                          (let ((utf-length (sb-impl::simd-character-string-utf8-length string)))
+                            (unless (= utf-length octet-length)
+                              (error "(sb-impl::simd-character-string-utf8-length ~s) => ~a /= ~a"
+                                     string utf-length octet-length))))
+                     (free-protected-array bytes))))))
+
 (defun encode-test (string byte-length)
   (let ((byte-array (make-protected-array byte-length '(unsigned-byte 8) nil)))
     (unwind-protect
@@ -140,7 +166,7 @@
 (compile 'decode-test.ascii)
 
 (with-test (:name :decode-test.ascii)
-  (loop for length from 1 to 128
+  (loop for length from 1 to 256
         for string = (make-string length)
         do
         (fill-random-string string t)
@@ -153,7 +179,7 @@
             (free-protected-array bytes)))))
 
 (with-test (:name :encode-test.ascii)
-  (loop for length from 1 to 128
+  (loop for length from 1 to 256
         for string = (make-protected-array length 'character nil)
         do
         (unwind-protect

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


hooks/post-receive
-- 
SBCL