Raymond Toy pushed to branch issue-316-support-roundtrip-char-casing at cmucl / cmucl

Commits:

2 changed files:

Changes:

  • bin/run-ansi-tests.sh
    ... ... @@ -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
    

  • src/code/unidata.lisp
    ... ... @@ -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))))))