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

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] For string casing test all non-surrogate characters
by Raymond Toy (＠rtoy) 17 May '24

17 May '24

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/6d80142c9e62bfe0ef6f426… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/6d80142c9e62bfe0ef6f426… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] Update string-upcase/downcase to match char-upcase/downcase
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 834b3092 by Raymond Toy at 2024-05-16T16:48:00-07:00 Update string-upcase/downcase to match char-upcase/downcase Because char-upcase/downcase changed, we need to update string-upcase/downcase to match what the functions do. - - - - - 1 changed file: - src/code/string.lisp Changes: ===================================== src/code/string.lisp ===================================== @@ -642,9 +642,13 @@ (when wide (incf index)) ;; Handle ASCII specially because this is called early in ;; initialization, before unidata is available. + #+nil (cond ((< 96 code 123) (decf code 32)) #+unicode ((> code 127) (setq code (unicode-upper code)))) + (if wide + (setq code (unicode-upper code)) + (setf code (char-code (char-upcase (code-char code))))) ;;@@ WARNING: this may, in theory, need to extend newstring ;; but that never actually occurs as of Unicode 5.1.0, ;; so I'm just going to ignore it for now... @@ -684,8 +688,12 @@ (when wide (incf index)) ;; Handle ASCII specially because this is called early in ;; initialization, before unidata is available. + #+nil (cond ((< 64 code 91) (incf code 32)) ((> code 127) (setq code (unicode-lower code)))) + (if wide + (setq code (unicode-lower code)) + (setq code (char-code (char-downcase (code-char code))))) ;;@@ WARNING: this may, in theory, need to extend newstring ;; but that never actually occurs as of Unicode 5.1.0, ;; so I'm just going to ignore it for now... View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/834b3092d9e2f122f1b858c… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/834b3092d9e2f122f1b858c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] Add string casing tests
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 1e72a851 by Raymond Toy at 2024-05-16T15:27:44-07:00 Add string casing tests Add a couple of simple tests to check that string-upcase/downcase produces the same results as if we did char-upcase/downcase on each character individually. We only do a few characters. (Should we do more?) - - - - - 1 changed file: - + tests/string.lisp Changes: ===================================== tests/string.lisp ===================================== @@ -0,0 +1,41 @@ +;; Tests of string functions + +(defpackage :string-tests + (:use :cl :lisp-unit)) + +(in-package "STRING-TESTS") + +(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))))) + +(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))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e72a851ecfc3dfed349d80… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1e72a851ecfc3dfed349d80… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Let deftransforms do the right thing for char-upcase/downcase
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 95e6ffdd by Raymond Toy at 2024-05-16T14:04:14-07:00 Let deftransforms do the right thing for char-upcase/downcase Instead of maintaining duplicate code in the functions char-upcase/downcase and in the deftransforms for these functions, change the implementation of the functions to call themselves. This looks like infinite recursion, but the deftransforms are nicely applied so that we only have one copy of the code now. - - - - - f3dac007 by Raymond Toy at 2024-05-16T14:05:53-07:00 Slightly simplify implementation of char-upcase/downcase transforms First, change the arg type from `base-char` to `character` (which are the same in cmucl). Second, for `char-upcase`, we only upcase a Unicode character if it is a lower-case letter (category "Ll"). Likewise for `char-downcase`, we only downcase if the character is an upper-case letter (category "Lu"). Everything else is ignored. - - - - - 2 changed files: - src/code/char.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -463,18 +463,7 @@ (defun char-upcase (char) "Returns CHAR converted to upper-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 ((< 96 m 123) (code-char (- m 32))) - ((> m +unicode-lower-limit+) - (if (member (unicode-category m) '(92 32 75 109)) - char - (code-char (unicode-upper m)))) - (t char)))) + (char-upcase char)) (defun char-titlecase (char) "Returns CHAR converted to title-case if that is possible." @@ -492,18 +481,7 @@ (defun char-downcase (char) "Returns CHAR converted to lower-case if that is possible." (declare (character char)) - #-(and unicode (not unicode-bootstrap)) - (if (upper-case-p char) - (code-char (+ (char-code char) 32)) - char) - #+(and unicode (not unicode-bootstrap)) - (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) - (if (member (unicode-category m) '(92 75 109)) - char - (code-char (unicode-lower m)))) - ((< 64 m 91) (code-char (+ m 32))) - (t char)))) + (char-downcase char)) (defun digit-char (weight &optional (radix 10)) "All arguments must be integers. Returns a character object that ===================================== src/compiler/srctran.lisp ===================================== @@ -3335,9 +3335,8 @@ (= (lisp::equal-char-code a) (lisp::equal-char-code b))))) -(deftransform char-upcase ((x) (base-char)) +(deftransform char-upcase ((x) (character)) "open code" - ;; NOTE: This MUST match what the function char-upcase does. #-(and unicode (not unicode-bootstrap)) '(if (lower-case-p x) (code-char (- (char-code x) 32)) @@ -3345,25 +3344,22 @@ #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) (cond ((< 96 m 123) (code-char (- m 32))) - ((> m lisp::+unicode-lower-limit+) - (if (member (unicode-category m) '(92 32 75 109)) - x - (code-char (lisp::unicode-upper m)))) + ((and (> m lisp::+unicode-lower-limit+) + (= (unicode-category m) lisp::+unicode-category-lower+)) + (code-char (lisp::unicode-upper m))) (t x)))) -(deftransform char-downcase ((x) (base-char)) +(deftransform char-downcase ((x) (character)) "open code" - ;; NOTE: This MUST match what the function char-downcase does. #-(and unicode (not unicode-bootstrap)) '(if (upper-case-p x) (code-char (+ (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m lisp::+unicode-lower-limit+) - (if (member (unicode-category m) '(92 75 109)) - x - (code-char (lisp::unicode-lower m)))) + (cond ((and (> m lisp::+unicode-lower-limit+) + (= (unicode-category m) lisp::+unicode-category-upper+)) + (code-char (lisp::unicode-lower m))) ((< 64 m 91) (code-char (+ m 32))) (t x)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/37967a5048d11c50a9f6fe… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/37967a5048d11c50a9f6fe… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] Clean up the code and handle code-char 223 better.
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 37967a50 by Raymond Toy at 2024-05-16T07:07:17-07:00 Clean up the code and handle code-char 223 better. Clean up some code that had assumed that `+unicode-lower-limit+` was less than 191. Those special cases aren't needed anymore. For code 223 (Latin_Small_Letter_Sharp_S), add special case so that it is not a lower-case letter and therefore not both-case-p. - - - - - 1 changed file: - src/code/char.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -215,8 +215,7 @@ (let ((m (char-code (the base-char char)))) (or (< 31 m 127) #+(and unicode (not unicode-bootstrap)) - (and (/= m 181) - (> m +unicode-lower-limit+) + (and (> m +unicode-lower-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -251,6 +250,10 @@ (or (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) + ;; We don't want 223 to be a lower-case letter because + ;; CHAR-UPCASE returns the same character instead of the + ;; upper-case version. + (/= m 223) (= (unicode-category m) +unicode-category-lower+))))) (defun title-case-p (char) @@ -273,11 +276,7 @@ (or (< 64 m 91) (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) - ;; Unicode says Micro_sign is a lower case letter, but - ;; for CL, we don't want it to be a lower case letter. - ;; This is for compatibility with other Lisp - ;; implementations. - (/= m 181) + (/= m 223) (<= +unicode-category-upper+ (unicode-category m) +unicode-category-lower+))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/37967a5048d11c50a9f6fe2… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/37967a5048d11c50a9f6fe2… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Change unicode limit to 255
by Raymond Toy (＠rtoy) 16 May '24

16 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 7db93de9 by Raymond Toy at 2024-05-14T06:52:07-07:00 Change unicode limit to 255 Set the limit to 255 so that all 8-bit characters have a fast path that doesn't need to access the Unicode database. - - - - - 5fca5677 by Raymond Toy at 2024-05-15T17:44:06-07:00 Set unicode limit to 191 Update char-upcase and corresponding deftransform appropriately. - - - - - 2 changed files: - src/code/char.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -62,7 +62,7 @@ ;; This MUST be greater than or equal to 127! (defconstant +unicode-lower-limit+ - 127 + 191 "A character code strictly larger than this is handled using Unicode rules.") @@ -471,7 +471,6 @@ #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) (cond ((< 96 m 123) (code-char (- m 32))) - ((= m 181) char) ((> m +unicode-lower-limit+) (if (member (unicode-category m) '(92 32 75 109)) char ===================================== src/compiler/srctran.lisp ===================================== @@ -3345,7 +3345,6 @@ #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) (cond ((< 96 m 123) (code-char (- m 32))) - ((= m 181) x) ((> m lisp::+unicode-lower-limit+) (if (member (unicode-category m) '(92 32 75 109)) x View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6633e24c7b2beeb21e743b… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6633e24c7b2beeb21e743b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Implement the category cases in the CL functions, not Unicode
by Raymond Toy (＠rtoy) 14 May '24

14 May '24

Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl Commits: 1652ad4b by Raymond Toy at 2024-05-13T20:19:02-07:00 Implement the category cases in the CL functions, not Unicode Previously, we had unicode-upper/lower functions had the code to exclude the characters from the categories we didn't want. However, this should really be done in char-upcase/downcase because that's what we want from CL, not Unicode. - - - - - 6633e24c by Raymond Toy at 2024-05-13T20:21:17-07:00 Update the deftransforms for char-upcase/downcase to match The deftransforms for char-upcase/downcase better match the code for the functions char-upcase/downcase, otherwise, we get totally confusing results. I just copied the code from the functions into the deftransforms. We really need a better way to do this to guarantee this automatically! - - - - - 3 changed files: - src/code/char.lisp - src/code/unidata.lisp - src/compiler/srctran.lisp Changes: ===================================== src/code/char.lisp ===================================== @@ -215,7 +215,8 @@ (let ((m (char-code (the base-char char)))) (or (< 31 m 127) #+(and unicode (not unicode-bootstrap)) - (and (> m +unicode-lower-limit+) + (and (/= m 181) + (> m +unicode-lower-limit+) (>= (unicode-category m) +unicode-category-graphic+)))))) @@ -272,6 +273,11 @@ (or (< 64 m 91) (< 96 m 123) #+(and unicode (not unicode-bootstrap)) (and (> m +unicode-lower-limit+) + ;; Unicode says Micro_sign is a lower case letter, but + ;; for CL, we don't want it to be a lower case letter. + ;; This is for compatibility with other Lisp + ;; implementations. + (/= m 181) (<= +unicode-category-upper+ (unicode-category m) +unicode-category-lower+))))) @@ -464,8 +470,12 @@ char) #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) (code-char (unicode-upper m))) - ((< 96 m 123) (code-char (- m 32))) + (cond ((< 96 m 123) (code-char (- m 32))) + ((= m 181) char) + ((> m +unicode-lower-limit+) + (if (member (unicode-category m) '(92 32 75 109)) + char + (code-char (unicode-upper m)))) (t char)))) (defun char-titlecase (char) @@ -490,7 +500,10 @@ char) #+(and unicode (not unicode-bootstrap)) (let ((m (char-code char))) - (cond ((> m +unicode-lower-limit+) (code-char (unicode-lower m))) + (cond ((> m +unicode-lower-limit+) + (if (member (unicode-category m) '(92 75 109)) + char + (code-char (unicode-lower m)))) ((< 64 m 91) (code-char (+ m 32))) (t char)))) ===================================== src/code/unidata.lisp ===================================== @@ -883,9 +883,7 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (qref32 scase code) #xFF))) - (if (or (zerop n) - ;; Ignore category Lt, Mn, Nl, So - (member (unicode-category code) '(92 32 75 109))) + (if (zerop n) code (let* ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) @@ -896,9 +894,7 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (ash (qref32 scase code) -8) #xFF))) - (if (or (zerop n) - ;; Ignore category Lt, Nl, So - (member (unicode-category code) '(92 75 109))) + (if (zerop n) code (let ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) ===================================== src/compiler/srctran.lisp ===================================== @@ -3337,27 +3337,36 @@ (deftransform char-upcase ((x) (base-char)) "open code" + ;; NOTE: This MUST match what the function char-upcase does. #-(and unicode (not unicode-bootstrap)) '(if (lower-case-p x) (code-char (- (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m 127) (code-char (lisp::unicode-upper m))) - ((< 96 m 123) (code-char (- m 32))) + (cond ((< 96 m 123) (code-char (- m 32))) + ((= m 181) x) + ((> m lisp::+unicode-lower-limit+) + (if (member (unicode-category m) '(92 32 75 109)) + x + (code-char (lisp::unicode-upper m)))) (t x)))) (deftransform char-downcase ((x) (base-char)) "open code" + ;; NOTE: This MUST match what the function char-downcase does. #-(and unicode (not unicode-bootstrap)) '(if (upper-case-p x) (code-char (+ (char-code x) 32)) x) #+(and unicode (not unicode-bootstrap)) '(let ((m (char-code x))) - (cond ((> m 127) (code-char (lisp::unicode-lower m))) - ((< 64 m 91) (code-char (+ m 32))) - (t x)))) + (cond ((> m lisp::+unicode-lower-limit+) + (if (member (unicode-category m) '(92 75 109)) + x + (code-char (lisp::unicode-lower m)))) + ((< 64 m 91) (code-char (+ m 32))) + (t x)))) ;;;; Equality predicate transforms: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7f4f1e7590ba3a2326a91d… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7f4f1e7590ba3a2326a91d… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-316-support-roundtrip-char-casing] 2 commits: Ignore some categories when finding the upper or lower case character
by Raymond Toy (＠rtoy) 13 May '24

13 May '24

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 Ignore some categories when finding the upper or lower case character For `unicode-upper`, we ignore characters with the category Lt, Mn, Nl, and So and just return the character unchanged. Likewise, for `unicode-lower`, we ignore Lt, Nl, and So. - - - - - 7f4f1e75 by Raymond Toy at 2024-05-13T14:25:22-07:00 Checkout the correct branch for the ansi-test code. - - - - - 2 changed files: - bin/run-ansi-tests.sh - src/code/unidata.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -41,7 +41,7 @@ else fi cd ../ansi-test -git checkout issue-288-new-failures +git checkout issue-316-support-roundtrip-char-casing make LISP="$LISP batch -noinit -nositeinit" # There should be no unexpected successes or failures; check these separately ===================================== src/code/unidata.lisp ===================================== @@ -883,7 +883,9 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (qref32 scase code) #xFF))) - (if (zerop n) + (if (or (zerop n) + ;; Ignore category Lt, Mn, Nl, So + (member (unicode-category code) '(92 32 75 109))) code (let* ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) @@ -894,7 +896,9 @@ (unless (unidata-scase *unicode-data*) (load-scase)) (let* ((scase (unidata-scase *unicode-data*)) (n (logand (ash (qref32 scase code) -8) #xFF))) - (if (zerop n) + (if (or (zerop n) + ;; Ignore category Lt, Nl, So + (member (unicode-category code) '(92 75 109))) code (let ((m (aref (scase-svec scase) (logand n #x7F)))) (if (logbitp 7 n) (+ code m) (- code m)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d3452f1b14c8f6ab488fc… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d3452f1b14c8f6ab488fc… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-316-support-roundtrip-char-casing
by Raymond Toy (＠rtoy) 13 May '24

13 May '24

Raymond Toy pushed new branch issue-316-support-roundtrip-char-casing 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-316-support-roundtr… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-312-motif-server] Declare type_writer to have a void* arg instead of caddr_t.
by Raymond Toy (＠rtoy) 10 May '24

10 May '24

Raymond Toy pushed to branch issue-312-motif-server at cmucl / cmucl Commits: 2c4e223e by Raymond Toy at 2024-05-10T15:00:29-07:00 Declare type_writer to have a void* arg instead of caddr_t. Update datatrans.h so that message_write_float is declared to have a second arg of type void*. Then update implementation of message_write_float to have a matching function signature and cast the void* arg to float* so we can get the float value. - - - - - 3 changed files: - src/motif/server/datatrans.c - src/motif/server/datatrans.h - src/motif/server/tables.h Changes: ===================================== src/motif/server/datatrans.c ===================================== @@ -265,10 +265,12 @@ void message_write_color(message_t m,XColor *color,int tag) message_put_word(m,color->blue); } -void message_write_float(message_t m,float *f,int tag) +void message_write_float(message_t m,void *f,int tag) { + float *fl = (float *) f; + message_put_dblword(m,combine_type_and_data(tag,0)); - message_put_dblword(m,*f); + message_put_dblword(m,*fl); } ===================================== src/motif/server/datatrans.h ===================================== @@ -38,7 +38,7 @@ extern void message_write_int_list(); extern void message_write_event(); extern void message_write_color(); /* GCC complains without the full prototype */ -extern void message_write_float(message_t,float*,int); +extern void message_write_float(message_t,void*,int); ===================================== src/motif/server/tables.h ===================================== @@ -10,8 +10,8 @@ #ifndef TABLES_H #define TABLES_H -typedef void (*type_writer)(message_t out,caddr_t src,int type_tag); -typedef void (*type_reader)(message_t in,caddr_t dest,int type_tag,int data); +typedef void (*type_writer)(message_t out,void *src,int type_tag); +typedef void (*type_reader)(message_t in,void *dest,int type_tag,int data); typedef struct { String type; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c4e223e3a53f79e3c147a4… -- This project does not include diff previews in email notifications. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2c4e223e3a53f79e3c147a4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0