Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 6d80142c by Raymond Toy at 2024-05-16T18:56:02-07:00 For string casing test all non-surrogate characters For testing, create a string of all non-surrogate characters instead of just a handful that we were doing before. - - - - - 1 changed file: - tests/string.lisp Changes: ===================================== tests/string.lisp ===================================== @@ -5,37 +5,33 @@ (in-package "STRING-TESTS") +(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)) + (define-test string-upcase (:tag :issues) - (let ((s (coerce (mapcar #'code-char - ;; Some special characters for testing. - ;; Micro_Sign shouldn't upcase. #x1c5 and - ;; #x1c8 have a unicode category of Lt so - ;; they shouldn't upcase either. - '(#xb5 #x1c5 #x1c8)) - 'string))) - ;; Verify that string-upcase returns the same characters as if we - ;; did char-upcase on each one. (This only works if we don't have - ;; surrogate characters in the string!) - (assert-equal (map 'list #'(lambda (c) - (char-name (char-upcase c))) - s) - (map 'list #'char-name - (string-upcase s))))) + (let* ((s (make-test-string)) + (s-upcase (string-upcase s))) + (assert-false + (loop for expected across s + and actual across s-upcase + when (char/= actual (char-upcase expected)) + collect (list (char-upcase (char-code expected)) + (char-code actual)))))) (define-test string-downcase (:tag :issues) - (let ((s (coerce (mapcar #'code-char - ;; Some special characters for testing. - ;; Micro_Sign shouldn't upcase. #x1c5 and - ;; #x1c8 have a unicode category of Lt so - ;; they shouldn't upcase either. - '(#xb5 #x1c5 #x1c8)) - 'string))) - ;; Verify that string-downcase returns the same characters as if we - ;; did char-downcase on each one. (This only works if we don't have - ;; surrogate characters in the string!) - (assert-equal (map 'list #'(lambda (c) - (char-name (char-downcase c))) - s) - (map 'list #'char-name (string-downcase s))))) + (let* ((s (make-test-string)) + (s-downcase (string-downcase s))) + (assert-false + (loop for expected across s + and actual across s-downcase + when (char/= actual (char-downcase expected)) + collect (list (char-downcase (char-code expected)) + (char-code actual)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6d80142c9e62bfe0ef6f4265... -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6d80142c9e62bfe0ef6f4265... You're receiving this email because of your account on gitlab.common-lisp.net.