GitLab

at 2024-05-31T07:50:47-07:00

Make test string contain all possible characters.

Previously, we skipped over surrogates.

Update nstring casing functions.

Since we're not dealing with surrogate pairs, we can simplify the
functions quite a bit.

 	  (setf (schar newstring new-index) (schar string index)))

 	newstring))))

+#+nil

 (defun nstring-upcase (string &key (start 0) end)

   "Given a string, returns that string with all lower case alphabetic

   characters converted to uppercase."

 	      (setf (schar string (incf index)) lo))))))

     save-header))

+(defun nstring-upcase (string &key (start 0) end)

+  "Given a string, returns that string with all lower case alphabetic

+  characters converted to uppercase."

+  (declare (fixnum start))

+  (let ((save-header string))

+    (with-one-string string start end offset

+      (do ((index start (1+ index)))

+	  ((= index (the fixnum end)))

+	(declare (fixnum index))

+        (setf (schar string index)

+              (char-upcase (schar string index))))

+    save-header)))

+

+#+nil

 (defun nstring-downcase (string &key (start 0) end)

   "Given a string, returns that string with all upper case alphabetic

   characters converted to lowercase."

 	      (setf (schar string (incf index)) lo))))))

     save-header))

+(defun nstring-downcase (string &key (start 0) end)

+  "Given a string, returns that string with all upper case alphabetic

+  characters converted to lowercase."

+  (declare (fixnum start))

+  (let ((save-header string))

+    (with-one-string string start end offset

+      (do ((index start (1+ index)))

+	  ((= index (the fixnum end)))

+	(declare (fixnum index))

+        (setf (schar string index)

+              (char-downcase (schar string index)))))

+    save-header))

+

 (defun nstring-capitalize (string &key (start 0) end)

   "Given a string, returns that string with the first

   character of each ``word'' converted to upper-case, and remaining

 (defun make-test-string ()

   ;; Create a string consisting of all the code units EXCEPT for the

   ;; surrogates because string casing handles that differently.

-  (coerce

-   (loop for code from 0 to #xffff

-         unless (lisp::surrogatep code)

-         collect (code-char code))

-   'string))

+  (let ((s (make-string char-code-limit)))

+    (dotimes (k char-code-limit)

+      (setf (aref s k) (code-char k)))

+    s))

 (define-test string-upcase

     (:tag :issues)

Raymond Toy pushed to branch issue-323-cl-string-casing at cmucl / cmucl

Commits:

2 changed files:

Changes: