master: Add tests for simd-copy-ascii

stassats via Sbcl-commits <[email protected]> Sat, 18 Jul 2026 03:03:19 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  d6129e1920c793a9872defd020929a3e5d675fdc (commit)
      from  d3fa62156fd91ca3f69b3e906b98d6e5d006e22b (commit)

- Log -----------------------------------------------------------------
commit d6129e1920c793a9872defd020929a3e5d675fdc
Author: Stas Boukarev <[email protected]>
Date:   Sat Jul 18 01:30:59 2026 +0300

    Add tests for simd-copy-ascii
---
 tests/utf-8.impure.lisp | 68 ++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 61 insertions(+), 7 deletions(-)

diff --git a/tests/utf-8.impure.lisp b/tests/utf-8.impure.lisp
index 82b02f585..a3df61393 100644
--- a/tests/utf-8.impure.lisp
+++ b/tests/utf-8.impure.lisp
@@ -65,13 +65,16 @@
 
 (compile 'decode-test)
 
-(defun fill-random-string (string)
-  (map-into string (lambda ()
-                     (code-char (case (random 4)
-                                  (0 (random 128))
-                                  (1 (+ 128 (random (- 2048 128))))
-                                  (2 (+ 2048 (random (- 50000 2048))))
-                                  (3 (+ 65536 (random (- char-code-limit 65536)))))))))
+(defun fill-random-string (string &optional ascii)
+  (map-into string (if ascii
+                       (lambda ()
+                         (code-char (random 128)))
+                       (lambda ()
+                         (code-char (case (random 4)
+                                      (0 (random 128))
+                                      (1 (+ 128 (random (- 2048 128))))
+                                      (2 (+ 2048 (random (- 50000 2048))))
+                                      (3 (+ 65536 (random (- char-code-limit 65536))))))))))
 
 (with-test (:name :decode-test)
   (loop for length from 1 to 32
@@ -111,3 +114,54 @@
                           (error "(encode-test ~s ~a) => ~a /= ~a" string (length octets)
                                  result octets))))
           (free-protected-array string))))
+
+(defun encode-test.ascii (string byte-length)
+  (let ((byte-array (make-protected-array byte-length '(unsigned-byte 8) nil)))
+    (unwind-protect
+         (progn (sb-vm::simd-copy-character-string-to-ascii-byte-array byte-array
+                                                                      string
+                                                                      byte-length)
+                (copy-seq byte-array))
+      (free-protected-array byte-array))))
+
+(defun decode-test.ascii (vector string-length)
+  (sb-sys:with-pinned-objects (vector)
+    (let* ((length (length vector))
+           (string (make-protected-array string-length 'character nil)))
+      (unwind-protect
+           (progn (sb-vm::simd-copy-ascii-sap-to-character-string (sb-sys:vector-sap vector)
+                                                                 string
+                                                                 length)
+                  (copy-seq string))
+
+        (free-protected-array string)))))
+
+(compile 'encode-test.ascii)
+(compile 'decode-test.ascii)
+
+(with-test (:name :decode-test.ascii)
+  (loop for length from 1 to 128
+        for string = (make-string length)
+        do
+        (fill-random-string string t)
+        (let* ((octets (sb-ext:string-to-octets string))
+               (bytes (make-protected-array (length octets) '(unsigned-byte 8) nil)))
+          (unwind-protect
+               (progn (replace bytes octets)
+                      (assert (equal (decode-test.ascii bytes length)
+                                     string)))
+            (free-protected-array bytes)))))
+
+(with-test (:name :encode-test.ascii)
+  (loop for length from 1 to 128
+        for string = (make-protected-array length 'character nil)
+        do
+        (unwind-protect
+           (progn
+             (fill-random-string string t)
+             (let* ((octets (sb-ext:string-to-octets string))
+                    (result (encode-test.ascii string (length octets))))
+               (unless (equalp result octets)
+                 (error "(encode-test ~s ~a) => ~a /= ~a" string (length octets)
+                        result octets))))
+          (free-protected-array string))))

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


hooks/post-receive
-- 
SBCL