June 2024 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new branch issue-327-fix-crlf-lf-eol
by Raymond Toy (＠rtoy) 06 Jun '24

06 Jun '24

Raymond Toy pushed new branch issue-327-fix-crlf-lf-eol at cmucl / cmucl -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-327-fix-crlf-lf-eol You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update pot file
by Raymond Toy (＠rtoy) 06 Jun '24

06 Jun '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4238c627 by Raymond Toy at 2024-06-06T07:57:29-07:00 Update pot file Forgot to update this when moving title-case functions from char.lisp to unicode.lisp. - - - - - 1 changed file: - src/i18n/locale/cmucl.pot Changes: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5563,12 +5563,6 @@ msgid "" " argument is a lower-case character, NIL otherwise." msgstr "" -#: src/code/char.lisp -msgid "" -"The argument must be a character object; title-case-p returns T if the\n" -" argument is a title-case character, NIL otherwise." -msgstr "" - #: src/code/char.lisp msgid "" "The argument must be a character object. Both-case-p returns T if the\n" @@ -5657,10 +5651,6 @@ msgstr "" msgid "Returns CHAR converted to upper-case if that is possible." msgstr "" -#: src/code/char.lisp -msgid "Returns CHAR converted to title-case if that is possible." -msgstr "" - #: src/code/char.lisp msgid "Returns CHAR converted to lower-case if that is possible." msgstr "" @@ -15344,6 +15334,16 @@ msgid "" " the index." msgstr "" +#: src/code/unicode.lisp +msgid "Returns CHAR converted to title-case if that is possible." +msgstr "" + +#: src/code/unicode.lisp +msgid "" +"The argument must be a character object; title-case-p returns T if the\n" +" argument is a title-case character, NIL otherwise." +msgstr "" + #: src/code/unicode.lisp msgid "" "Capitalize String using the Unicode word-break algorithm to find\n" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4238c6273f8236c1ee7f820… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4238c6273f8236c1ee7f820… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-156-take-2-nan-comparison] Update CI with new name for bootstrap file.
by Raymond Toy (＠rtoy) 06 Jun '24

06 Jun '24

Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl Commits: a63fe0d0 by Raymond Toy at 2024-06-06T07:24:32-07:00 Update CI with new name for bootstrap file. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1,7 +1,7 @@ variables: download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2024/04" version: "2024-04-x86" - bootstrap: "-B boot-2023-08-1" + bootstrap: "-B boot-2024-04-1" stages: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a63fe0d0c933ed06bf0877e… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a63fe0d0c933ed06bf0877e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Add a .editorconfig file
by Carl Shapiro (＠cshapiro) 06 Jun '24

06 Jun '24

Carl Shapiro pushed to branch master at cmucl / cmucl Commits: 8b623d47 by Carl Shapiro at 2024-06-05T17:35:13-07:00 Add a .editorconfig file Specifies the indent and line ending style globally and adds our indentation size for C code. Most of the popular editors and code hosting sites understand this file. - - - - - d516417e by Carl Shapiro at 2024-06-06T00:38:22+00:00 Merge branch 'editorconfig' into 'master' Add a .editorconfig file See merge request cmucl/cmucl!226 - - - - - 1 changed file: - + .editorconfig Changes: ===================================== .editorconfig ===================================== @@ -0,0 +1,11 @@ +# http://editorconfig.org + +root = true + +[*] +indent_style = tab +insert_final_newline = true +tab_width = 8 + +[*.{c,h}] +indent_size = 4 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2f9576c33d38346f26cb72… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2f9576c33d38346f26cb72… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update with closed issues
by Raymond Toy (＠rtoy) 04 Jun '24

04 Jun '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 2f9576c3 by Raymond Toy at 2024-06-03T21:02:42-07:00 Update with closed issues Forgot to add some closed issues with the merges that closed the issues. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -30,7 +30,6 @@ public domain. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: - * * ~~#154~~ piglatin translation does not work anymore * ~~#171~~ Readably print `(make-pathname :name :unspecfic)` * ~~#180~~ Move `get-page-size` to C @@ -76,10 +75,12 @@ public domain. * ~~#297~~ Pprint `new-assem:assemble` with less indentation. * ~~#298~~ Add `with-float-rounding-mode` macro * ~~#299~~ Enable xoroshiro assembly routine + * ~~#312~~ Compiler error building motif server on Fedora 40 * ~~#314~~ tanh incorrect for large args * ~~#316~~ Support roundtrip character casing * ~~#320~~ Motif variant not defaulted for `x86_linux_clang` config * ~~#321~~ Rename Motif Config.x86 to Config.linux + * ~~#323~~ Make string casing functions compliant * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2f9576c33d38346f26cb72f… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2f9576c33d38346f26cb72f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #326: Cleanups for roundtrip casing
by Raymond Toy (＠rtoy) 04 Jun '24

04 Jun '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: db07d64f by Raymond Toy at 2024-06-04T03:52:11+00:00 Fix #326: Cleanups for roundtrip casing - - - - - 6b5da582 by Raymond Toy at 2024-06-04T03:52:16+00:00 Merge branch 'issue-326-char-casing-cleanup' into 'master' Fix #326: Cleanups for roundtrip casing Closes #326 See merge request cmucl/cmucl!225 - - - - - 4 changed files: - src/code/char.lisp - src/code/unicode.lisp - src/compiler/srctran.lisp - + tests/char.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -31,7 +31,6 @@ alphanumericp char= char/= char< char> char<= char>= char-equal char-not-equal char-lessp char-greaterp char-not-greaterp char-not-lessp character char-code code-char char-upcase - char-titlecase title-case-p char-downcase digit-char char-int char-name name-char codepoint-limit codepoint)) @@ -259,7 +258,7 @@ (declare (character char)) (and (typep char 'base-char) (let ((m (char-code (the base-char char)))) - (or (< 31 m 127) + (or (<= (char-code #\space ) m (char-code #\~)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -270,7 +269,8 @@ argument is an alphabetic character; otherwise NIL." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) @@ -282,7 +282,7 @@ argument is an upper-case character, NIL otherwise." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) + (or (<= (char-code #\A) m (char-code #\Z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m)))))))) @@ -293,29 +293,19 @@ argument is a lower-case character, NIL otherwise." (declare (character char)) (let ((m (char-code char))) - (or (< 96 m 123) + (or (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m)))))))) -(defun title-case-p (char) - "The argument must be a character object; title-case-p returns T if the - argument is a title-case character, NIL otherwise." - (declare (character char)) - (let ((m (char-code char))) - (or (< 64 m 91) - #+(and unicode (not unicode-bootstrap)) - (and (> m +ascii-limit+) - (= (unicode-category m) +unicode-category-title+))))) - - (defun both-case-p (char) "The argument must be a character object. Both-case-p returns T if the argument is an alphabetic character and if the character exists in both upper and lower case. For ASCII, this is the same as Alpha-char-p." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (case-mapping-entry m))))))) @@ -347,7 +337,9 @@ (declare (character char)) (let ((m (char-code char))) ;; Shortcut for ASCII digits and upper and lower case ASCII letters - (or (< 47 m 58) (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\0) m (char-code #\9)) + (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) @@ -418,14 +410,14 @@ (defmacro equal-char-code (character) `(let ((ch (char-code ,character))) - ;; Handle ASCII separately for bootstrapping and for unidata missing. - (if (< 64 ch 91) - (+ ch 32) - #-(and unicode (not unicode-bootstrap)) - ch - #+(and unicode (not unicode-bootstrap)) - (if (> ch +ascii-limit+) (unicode-lower ch) ch)))) - + ;; Handle ASCII separately for bootstrapping. + (cond ((<= (char-code #\A) ch (char-code #\Z)) + (logxor ch #x20)) + #+(and unicode (not unicode-bootstrap)) + ((> ch +ascii-limit+) + (case-mapping-lower-case ch)) + (t + ch)))) (defun char-equal (character &rest more-characters) "Returns T if all of its arguments are the same character. @@ -504,19 +496,6 @@ (declare (character char)) (char-upcase char)) -(defun char-titlecase (char) - "Returns CHAR converted to title-case if that is possible." - (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (lower-case-p char) - (code-char (- (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((> m +ascii-limit+) (code-char (unicode-title m))) - ((< 96 m 123) (code-char (- m 32))) - (t char)))) - (defun char-downcase (char) "Returns CHAR converted to lower-case if that is possible." (declare (character char)) ===================================== src/code/unicode.lisp ===================================== @@ -488,6 +488,26 @@ (declare (ignore c)) (lookup (+ i (if (eql widep 1) 2 1)) (left-context i)))))))) +(defun char-titlecase (char) + "Returns CHAR converted to title-case if that is possible." + (declare (character char)) + (let ((m (char-code char))) + (cond ((<= (char-code #\a) m (char-code #\z)) + (code-char (logxor m #x20))) + #+(and unicode (not unicode-bootstrap)) + ((> m +ascii-limit+) (code-char (unicode-title m))) + (t char)))) + +(defun title-case-p (char) + "The argument must be a character object; title-case-p returns T if the + argument is a title-case character, NIL otherwise." + (declare (character char)) + (let ((m (char-code char))) + (or (<= (code-char #\A) m (code-char #\Z)) + #+(and unicode (not unicode-bootstrap)) + (and (> m +ascii-limit+) + (= (unicode-category m) +unicode-category-title+))))) + (defun string-capitalize-unicode (string &key (start 0) end (casing :simple)) "Capitalize String using the Unicode word-break algorithm to find the words in String. The beginning is capitalized depending on the ===================================== src/compiler/srctran.lisp ===================================== @@ -3343,7 +3343,8 @@ x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((< 96 m 123) (code-char (- m 32))) + (cond ((<= (char-code #\a) m (char-code #\z)) + (code-char (logxor m #x20))) ((> m lisp::+ascii-limit+) (code-char (lisp::case-mapping-upper-case m))) (t x)))) @@ -3356,7 +3357,8 @@ x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((< 64 m 91) (code-char (+ m 32))) + (cond ((<= (char-code #\A) m (char-code #\Z)) + (code-char (logxor m #x20))) ((> m lisp::+ascii-limit+) (code-char (lisp::case-mapping-lower-case m))) (t x)))) ===================================== tests/char.lisp ===================================== @@ -0,0 +1,24 @@ +;; Tests of char functions + +(defpackage :char-tests + (:use :cl :lisp-unit)) + +(in-package "CHAR-TESTS") + +(define-test char-equal + (:tag :issues) + (let ((test-codes + ;; Find all the codes where the CL lower case character + ;; doesn't match the Unicode lower case character. + (loop for code from 128 below char-code-limit + for ch = (code-char code) + when (/= (char-code (char-downcase ch)) (or (lisp::unicode-lower code) code)) + collect code))) + (dolist (code test-codes) + ;; Verify that we convert to the CL lower case character instead + ;; of the Unicode lower case character for the cases where these + ;; are different. + (assert-false (char-equal (code-char (lisp::unicode-lower code)) + (code-char code)) + code + (lisp::unicode-lower code))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/57d5a21c20064990ff4717… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/57d5a21c20064990ff4717… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-326-char-casing-cleanup] More cleanup for char-titlecase and title-case-p
by Raymond Toy (＠rtoy) 04 Jun '24

04 Jun '24

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl Commits: 41270e6b by Raymond Toy at 2024-06-03T19:46:29-07:00 More cleanup for char-titlecase and title-case-p Use inclusive limits for the range checks in these two functions. For `char-titlecase`, simplify the non-unicode and unicode parts together. And use `logxor` to flip the case. - - - - - 1 changed file: - src/code/unicode.lisp Changes: ===================================== src/code/unicode.lisp ===================================== @@ -401,15 +401,11 @@ (defun char-titlecase (char) "Returns CHAR converted to title-case if that is possible." (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (lower-case-p char) - (code-char (- (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) - (cond ((> m +ascii-limit+) (code-char (unicode-title m))) - ((< (char-code #\`) m (char-code #\{)) - (code-char (- m 32))) + (cond ((<= (char-code #\a) m (char-code #\z)) + (code-char (logxor m #x20))) + #+(and unicode (not unicode-bootstrap)) + ((> m +ascii-limit+) (code-char (unicode-title m))) (t char)))) (defun title-case-p (char) @@ -417,7 +413,7 @@ argument is a title-case character, NIL otherwise." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) + (or (<= (code-char #\A) m (code-char #\Z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (= (unicode-category m) +unicode-category-title+))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/41270e6b15507c3493b4533… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/41270e6b15507c3493b4533… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-326-char-casing-cleanup] Use inclusive range for character ranges
by Raymond Toy (＠rtoy) 03 Jun '24

03 Jun '24

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl Commits: 50f6079f by Raymond Toy at 2024-06-03T16:55:26-07:00 Use inclusive range for character ranges First, make the range checks be inclusive instead of exclusive to make it easier to reason about. Second, replace the character codes with the corresponding character so 64 becomes `(char-code #\A)`, which is much more obvious what the character is. - - - - - 2 changed files: - src/code/char.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -258,7 +258,7 @@ (declare (character char)) (and (typep char 'base-char) (let ((m (char-code (the base-char char)))) - (or (< 31 m 127) + (or (<= (char-code #\space ) m (char-code #\~)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -269,7 +269,8 @@ argument is an alphabetic character; otherwise NIL." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) @@ -281,7 +282,7 @@ argument is an upper-case character, NIL otherwise." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) + (or (<= (char-code #\A) m (char-code #\Z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m)))))))) @@ -292,7 +293,7 @@ argument is a lower-case character, NIL otherwise." (declare (character char)) (let ((m (char-code char))) - (or (< 96 m 123) + (or (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m)))))))) @@ -303,7 +304,8 @@ both upper and lower case. For ASCII, this is the same as Alpha-char-p." (declare (character char)) (let ((m (char-code char))) - (or (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (not (zerop (case-mapping-entry m))))))) @@ -335,7 +337,9 @@ (declare (character char)) (let ((m (char-code char))) ;; Shortcut for ASCII digits and upper and lower case ASCII letters - (or (< 47 m 58) (< 64 m 91) (< 96 m 123) + (or (<= (char-code #\0) m (char-code #\9)) + (<= (char-code #\A) m (char-code #\Z)) + (<= (char-code #\a) m (char-code #\z)) #+(and unicode (not unicode-bootstrap)) (and (> m +ascii-limit+) (<= +unicode-category-letter+ (unicode-category m) ===================================== src/compiler/srctran.lisp ===================================== @@ -3343,7 +3343,7 @@ x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((< (char-code #\`) m (char-code #\{)) + (cond ((<= (char-code #\a) m (char-code #\z)) (code-char (logxor m #x20))) ((> m lisp::+ascii-limit+) (code-char (lisp::case-mapping-upper-case m))) @@ -3357,7 +3357,7 @@ x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((< (char-code #\@) m (char-code #\[)) + (cond ((<= (char-code #\A) m (char-code #\Z)) (code-char (logxor m #x20))) ((> m lisp::+ascii-limit+) (code-char (lisp::case-mapping-lower-case m))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/50f6079f8e180a096d33025… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/50f6079f8e180a096d33025… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-326-char-casing-cleanup] Move char-titlecase and title-case-p to unicode.lisp
by Raymond Toy (＠rtoy) 03 Jun '24

03 Jun '24

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl Commits: ad7b90b0 by Raymond Toy at 2024-06-03T16:16:56-07:00 Move char-titlecase and title-case-p to unicode.lisp These aren't needed for CL casing functions, so just move them as is to unicode.lisp, where they are used. - - - - - 2 changed files: - src/code/char.lisp - src/code/unicode.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -31,7 +31,6 @@ alphanumericp char= char/= char< char> char<= char>= char-equal char-not-equal char-lessp char-greaterp char-not-greaterp char-not-lessp character char-code code-char char-upcase - char-titlecase title-case-p char-downcase digit-char char-int char-name name-char codepoint-limit codepoint)) @@ -298,17 +297,6 @@ (and (> m +ascii-limit+) (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m)))))))) -(defun title-case-p (char) - "The argument must be a character object; title-case-p returns T if the - argument is a title-case character, NIL otherwise." - (declare (character char)) - (let ((m (char-code char))) - (or (< 64 m 91) - #+(and unicode (not unicode-bootstrap)) - (and (> m +ascii-limit+) - (= (unicode-category m) +unicode-category-title+))))) - - (defun both-case-p (char) "The argument must be a character object. Both-case-p returns T if the argument is an alphabetic character and if the character exists in @@ -504,20 +492,6 @@ (declare (character char)) (char-upcase char)) -(defun char-titlecase (char) - "Returns CHAR converted to title-case if that is possible." - (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (lower-case-p char) - (code-char (- (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((> m +ascii-limit+) (code-char (unicode-title m))) - ((< (char-code #\`) m (char-code #\{)) - (code-char (- m 32))) - (t char)))) - (defun char-downcase (char) "Returns CHAR converted to lower-case if that is possible." (declare (character char)) ===================================== src/code/unicode.lisp ===================================== @@ -398,6 +398,30 @@ (declare (ignore c)) (lookup (+ i (if (eql widep 1) 2 1)) (left-context i)))))))) +(defun char-titlecase (char) + "Returns CHAR converted to title-case if that is possible." + (declare (character char)) + #-(and unicode (not unicode-bootstrap)) + (if (lower-case-p char) + (code-char (- (char-code char) 32)) + char) + #+(and unicode (not unicode-bootstrap)) + (let ((m (char-code char))) + (cond ((> m +ascii-limit+) (code-char (unicode-title m))) + ((< (char-code #\`) m (char-code #\{)) + (code-char (- m 32))) + (t char)))) + +(defun title-case-p (char) + "The argument must be a character object; title-case-p returns T if the + argument is a title-case character, NIL otherwise." + (declare (character char)) + (let ((m (char-code char))) + (or (< 64 m 91) + #+(and unicode (not unicode-bootstrap)) + (and (> m +ascii-limit+) + (= (unicode-category m) +unicode-category-title+))))) + (defun string-capitalize-unicode (string &key (start 0) end (casing :simple)) "Capitalize String using the Unicode word-break algorithm to find the words in String. The beginning is capitalized depending on the View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ad7b90b066dd137718e0ce4… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ad7b90b066dd137718e0ce4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-326-char-casing-cleanup] 4 commits: Fix typo in the lower limit for char-upcase.
by Raymond Toy (＠rtoy) 03 Jun '24

03 Jun '24

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl Commits: b8887cd6 by Raymond Toy at 2024-06-03T14:38:08-07:00 Fix typo in the lower limit for char-upcase. We use a lower limit of `#\a`, but we really should have used `#\``. - - - - - e4a3d3b5 by Raymond Toy at 2024-06-03T15:59:09-07:00 Fix equal-char-code to use CL lowercase Previously, `equal-char-code` used the Unicode function `unicode-lower` to convert the character to lower case. That's not what we want; we want to use the CL lower case character. Thus, use `case-mapping-lower-case` to get the desired character code. Add a test for `char-equal` that shows we've fixed this. - - - - - c3e7e0b4 by Raymond Toy at 2024-06-03T16:11:47-07:00 Simplify equal-char-code as suggested. Replace the nested `if`'s with a `cond`. Change the bounds to be inclusive to make it easier to reason about the range of characters. - - - - - 7c711f4f by Raymond Toy at 2024-06-03T16:12:48-07:00 Fix a typo and add a comment. - - - - - 3 changed files: - src/code/char.lisp - src/compiler/srctran.lisp - + tests/char.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -418,14 +418,14 @@ (defmacro equal-char-code (character) `(let ((ch (char-code ,character))) - ;; Handle ASCII separately for bootstrapping and for unidata missing. - (if (< (char-code #\@) ch (char-code #\[)) - (+ ch 32) - #-(and unicode (not unicode-bootstrap)) - ch - #+(and unicode (not unicode-bootstrap)) - (if (> ch +ascii-limit+) (unicode-lower ch) ch)))) - + ;; Handle ASCII separately for bootstrapping. + (cond ((<= (char-code #\A) ch (char-code #\Z)) + (logxor ch #x20)) + #+(and unicode (not unicode-bootstrap)) + ((> ch +ascii-limit+) + (case-mapping-lower-case ch)) + (t + ch)))) (defun char-equal (character &rest more-characters) "Returns T if all of its arguments are the same character. ===================================== src/compiler/srctran.lisp ===================================== @@ -3343,7 +3343,7 @@ x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((< (char-code #\a) m (char-code #\{)) + (cond ((< (char-code #\`) m (char-code #\{)) (code-char (logxor m #x20))) ((> m lisp::+ascii-limit+) (code-char (lisp::case-mapping-upper-case m))) ===================================== tests/char.lisp ===================================== @@ -0,0 +1,24 @@ +;; Tests of char functions + +(defpackage :char-tests + (:use :cl :lisp-unit)) + +(in-package "CHAR-TESTS") + +(define-test char-equal + (:tag :issues) + (let ((test-codes + ;; Find all the codes where the CL lower case character + ;; doesn't match the Unicode lower case character. + (loop for code from 128 below char-code-limit + for ch = (code-char code) + when (/= (char-code (char-downcase ch)) (or (lisp::unicode-lower code) code)) + collect code))) + (dolist (code test-codes) + ;; Verify that we convert to the CL lower case character instead + ;; of the Unicode lower case character for the cases where these + ;; are different. + (assert-false (char-equal (code-char (lisp::unicode-lower code)) + (code-char code)) + code + (lisp::unicode-lower code))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ca36c16321c2028784aaa3… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ca36c16321c2028784aaa3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0