GitLab

at 2024-05-31T16:20:11-07:00

CL-compliant string-capitalize

Previously, when we capitalized a word, we used the titlecase.
However it should be upper case.  Make it so, but move the original
implementation to unicode.lisp.

Add a test that we do use uppercase instead of titlecase.

@@ -706,7 +706,7 @@
  		 (setq newword t))
  		(newword
  		 ;;char is first case-modifiable after non-case-modifiable
 -		 (setq char (char-titlecase char))
 +		 (setq char (char-upcase char))
  		 (setq newword ()))
  		;;char is case-modifiable, but not first
  		(t (setq char (char-downcase char))))

@@ -525,6 +525,48 @@
  			    :end next)))
  	  (write-string string result :start end :end offset-slen))))))
 +(defun string-capitalize-simple (string &key (start 0) end)
 +  _N"Given a string, returns a copy of the string with the first
 +  character of each ``word'' converted to upper-case, and remaining
 +  chars in the word converted to lower case. A ``word'' is defined
 +  to be a string of case-modifiable characters delimited by
 +  non-case-modifiable chars."
 +  (declare (fixnum start))
 +  (let* ((string (if (stringp string) string (string string)))
 +	 (slen (length string)))
 +    (declare (fixnum slen))
 +    (with-one-string string start end offset
 +      (let ((offset-slen (+ slen offset))
 +	    (newstring (make-string slen)))
 +	(declare (fixnum offset-slen))
 +	(do ((index offset (1+ index))
 +	     (new-index 0 (1+ new-index)))
 +	    ((= index start))
 +	  (declare (fixnum index new-index))
 +	  (setf (schar newstring new-index) (schar string index)))
 +	(do ((index start (1+ index))
 +	     (new-index (- start offset) (1+ new-index))
 +	     (newword t)
 +	     (char ()))
 +	    ((= index (the fixnum end)))
 +	  (declare (fixnum index new-index))
 +	  (setq char (schar string index))
 +	  (cond ((not (alphanumericp char))
 +		 (setq newword t))
 +		(newword
 +		 ;;char is first case-modifiable after non-case-modifiable
 +		 (setq char (char-titlecase char))
 +		 (setq newword ()))
 +		;;char is case-modifiable, but not first
 +		(t (setq char (char-downcase char))))
 +	  (setf (schar newstring new-index) char))
 +	(do ((index end (1+ index))
 +	     (new-index (- (the fixnum end) offset) (1+ new-index)))
 +	    ((= index offset-slen))
 +	  (declare (fixnum index new-index))
 +	  (setf (schar newstring new-index) (schar string index)))
 +	newstring))))
++
  (defun string-capitalize-full (string &key (start 0) end (casing :full))
    "Capitalize String using the Common Lisp word-break algorithm to find
    the words in String.  The beginning is capitalized depending on the
@@ -599,7 +641,7 @@
    (if unicode-word-break
        (string-capitalize-unicode string :start start :end end :casing casing)
        (if (eq casing :simple)
 -	  (cl:string-capitalize string :start start :end end)
 +	  (cl:string-capitalize-simple string :start start :end end)
  	  (string-capitalize-full string :start start :end end :casing casing))))

@@ -3892,7 +3892,7 @@ msgid ""
  "  upper case alphabetic characters converted to lowercase."
  msgstr ""
 -#: src/code/string.lisp
 +#: src/code/unicode.lisp src/code/string.lisp
  msgid ""
  "Given a string, returns a copy of the string with the first\n"
  "  character of each ``word'' converted to upper-case, and remaining\n"

@@ -58,3 +58,36 @@
             when (char/= actual (char-downcase expected))
               collect (list (char-downcase expected)
                             (char-code actual))))))
++
 +(define-test string-capitalize
 +    (:tag :issues)
 +  (let* ((s (string-capitalize
 +             ;; #\Latin_Small_Letter_Dz and #\Latin_Small_Letter_Lj
 +             ;; #have Unicode titlecase characters that differ from
 +             ;; CHAR-UPCASE.  This tests that STRING-CAPITALIZE use
 +             ;; CHAR-UPCASE to produce the capitalization.
 +             (coerce
 +              '(#\Latin_Small_Letter_Dz
 +                #\a #\b
 +                #\space
 +                #\Latin_Small_Letter_Lj
 +                #\A #\B)
 +              'string)))
 +         (expected
 +           ;; Manually convert the test string by calling CHAR-UPCASE
 +           ;; or CHAR-DOWNCASE (or IDENTITY) to get the desired
 +           ;; capitalized string.
 +           (map 'list
 +                #'(lambda (c f)
 +                    (funcall f c))
 +                s
 +                (list #'char-upcase
 +                      #'char-downcase
 +                      #'char-downcase
 +                      #'identity
 +                      #'char-upcase
 +                      #'char-downcase
 +                      #'char-downcase))))
 +    (assert-equal
 +     (map 'list #'char-name expected)
 +     (map 'list #'char-name s))))

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

Commits:

4 changed files:

Changes: