Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl
Commits:
-
3a0f81e8
by Raymond Toy at 2024-05-13T14:23:47-07:00
-
7f4f1e75
by Raymond Toy at 2024-05-13T14:25:22-07:00
2 changed files:
Changes:
... | ... | @@ -41,7 +41,7 @@ else |
41 | 41 | fi
|
42 | 42 | |
43 | 43 | cd ../ansi-test
|
44 | -git checkout issue-288-new-failures
|
|
44 | +git checkout issue-316-support-roundtrip-char-casing
|
|
45 | 45 | |
46 | 46 | make LISP="$LISP batch -noinit -nositeinit"
|
47 | 47 | # There should be no unexpected successes or failures; check these separately
|
... | ... | @@ -883,7 +883,9 @@ |
883 | 883 | (unless (unidata-scase *unicode-data*) (load-scase))
|
884 | 884 | (let* ((scase (unidata-scase *unicode-data*))
|
885 | 885 | (n (logand (qref32 scase code) #xFF)))
|
886 | - (if (zerop n)
|
|
886 | + (if (or (zerop n)
|
|
887 | + ;; Ignore category Lt, Mn, Nl, So
|
|
888 | + (member (unicode-category code) '(92 32 75 109)))
|
|
887 | 889 | code
|
888 | 890 | (let* ((m (aref (scase-svec scase) (logand n #x7F))))
|
889 | 891 | (if (logbitp 7 n) (+ code m) (- code m))))))
|
... | ... | @@ -894,7 +896,9 @@ |
894 | 896 | (unless (unidata-scase *unicode-data*) (load-scase))
|
895 | 897 | (let* ((scase (unidata-scase *unicode-data*))
|
896 | 898 | (n (logand (ash (qref32 scase code) -8) #xFF)))
|
897 | - (if (zerop n)
|
|
899 | + (if (or (zerop n)
|
|
900 | + ;; Ignore category Lt, Nl, So
|
|
901 | + (member (unicode-category code) '(92 75 109)))
|
|
898 | 902 | code
|
899 | 903 | (let ((m (aref (scase-svec scase) (logand n #x7F))))
|
900 | 904 | (if (logbitp 7 n) (+ code m) (- code m))))))
|