Raymond Toy pushed to branch issue-323-cl-string-casing at cmucl / cmucl Commits: db08decf by Raymond Toy at 2024-05-31T07:50:47-07:00 Make test string contain all possible characters. Previously, we skipped over surrogates. - - - - - 0da20df4 by Raymond Toy at 2024-05-31T08:05:47-07:00 Update nstring casing functions. Since we're not dealing with surrogate pairs, we can simplify the functions quite a bit. - - - - - 2 changed files: - src/code/string.lisp - tests/string.lisp Changes: ===================================== src/code/string.lisp ===================================== @@ -804,6 +804,7 @@ (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." @@ -828,6 +829,20 @@ (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." @@ -852,6 +867,19 @@ (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 ===================================== tests/string.lisp ===================================== @@ -8,11 +8,10 @@ (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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ed36bab589e90fc2a222a6d... -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ed36bab589e90fc2a222a6d... You're receiving this email because of your account on gitlab.common-lisp.net.