Tests fail on SBCL 2.6.1

[aadcg]

(asdf:test-system :babel) fails with:

#<test-run: 61 tests, 502 assertions, 2 failures in 0.039806 sec (0 failed assertions, 2 errors, none expected)> 

Test failures:

Failure 1: UNEXPECTED-ERROR when running BABEL-TESTS::RW-EQUIV.1

    #<TYPE-ERROR expected-type: (MOD 1114112) datum: NIL>

Failure 2: UNEXPECTED-ERROR when running BABEL-TESTS::ENCODER/DECODER-RETVALS

    #<TYPE-ERROR expected-type: (MOD 1114112) datum: NIL>

[grawlinson]

Getting the same test failures with sbcl 2.6.2.

#<test-run: 61 tests, 502 assertions, 2 failures in 0.109706 sec (0 failed assertions, 2 errors, none expected)>

Test failures:

Failure 1: UNEXPECTED-ERROR when running BABEL-TESTS::RW-EQUIV.1

    #<TYPE-ERROR expected-type: (MOD 1114112) datum: NIL>

Failure 2: UNEXPECTED-ERROR when running BABEL-TESTS::ENCODER/DECODER-RETVALS

    #<TYPE-ERROR expected-type: (MOD 1114112) datum: NIL>

[aadcg]

I investigated the issue.

As far as I can tell, PR #61 was merged without checking if the test suite successfully passes for the newly added :ksc_5601 encoding. Concretely, the implementation didn't take ASCII passthrough into account. I.e. (octets-to-string (string-to-octets *standard-characters*) :encoding :ksc_5601) must return *standard-characters*.

I came up with a solution with the help of LLMs, but I don't have the expertise to review it. @wsgac, it would be great if you'd be able to take a deeper look.

modified   src/enc-ksc-5601.lisp
@@ -1257,42 +1257,49 @@ defun ksc-5601-to-utf8
       (t #xfffd))))
 
 (define-character-encoding :ksc_5601
-    "A 16-bit, fixed-width character encoding for the Korean language"
+  "KS C 5601 (EUC-KR) encoding with ASCII passthrough"
   :aliases '(:ks_c_5601 :ks_c_5601-1987 :ksc_5601-1987 :wansung)
-  :code-unit-size 16
+  :code-unit-size 8                ;; variable-width: 1 or 2 bytes
   :default-replacement #xfffd
   :codespace `(,+unicode-to-ksc-5601+))
 
 (define-code-point-counter :ksc_5601 (getter type)
   `(named-lambda ksc-5601-code-point-counter (seq start end max)
      (declare (type ,type seq) (fixnum start end max))
-     (multiple-value-bind (count rem)
-         (floor (- end start) 2)
-       (cond
-         ((and (plusp max) (> count max))
-          (values max (the fixnum (+ start (* 2 max)))))
-         (t
-          (unless (zerop rem)
-            (let ((vector (make-array 2 :fill-pointer 0)))
-              (dotimes (i rem)
-                (vector-push (,getter seq (+ i (- end rem))) vector))
-              (decoding-error vector :ksc_5601 seq (the fixnum (- end rem)) nil
-                              'end-of-input-in-character)
-              (decf end rem)))
-          (values count end))))))
+     (let ((i start)
+           (count 0))
+       (loop while (< i end)
+             do
+                (let ((b1 (,getter seq i)))
+                  (if (< b1 #x80)
+                      (incf i 1)  ;; ASCII
+                      (incf i 2))) ;; KS C 5601
+                (incf count)
+                (when (and (plusp max) (>= count max))
+                  (return (values max i))))
+       (values count i))))
+
 
 (define-encoder :ksc_5601 (getter src-type setter dest-type)
   `(named-lambda ksc-5601-encoder (src start end dest d-start)
      (declare (type ,src-type src)
               (type ,dest-type dest)
               (fixnum start end d-start))
-     (loop for i fixnum from start below end
-           and di fixnum from d-start by 2
+     (loop with di fixnum = d-start
+           for i fixnum from start below end
            for code of-type code-point = (,getter src i)
-           for ksc-5601 of-type code-point = (utf8-to-ksc-5601 code)
-           unless ksc-5601
-             do (handle-error)
-           do (,setter ksc-5601 dest di 2 :be)
+           do
+              (if (< code #x80)
+                  ;; ASCII fast path
+                  (progn
+                    (,setter code dest di)
+                    (incf di 1))
+                  ;; KS C 5601
+                  (let ((ksc-5601 (utf8-to-ksc-5601 code)))
+                    (unless ksc-5601
+                      (handle-error))
+                    (,setter ksc-5601 dest di 2 :be)
+                    (incf di 2)))
            finally (return (the fixnum (- di d-start))))))
 
 (define-decoder :ksc_5601 (getter src-type setter dest-type)
@@ -1300,9 +1307,26 @@ define-decoder :ksc_5601
      (declare (type ,src-type src)
               (type ,dest-type dest)
               (fixnum start end d-start))
-     (loop for i fixnum from start below end by 2
-           and di fixnum from d-start
-           for ksc-5601 of-type code-point = (,getter src i 2)
-           for code of-type code-point = (ksc-5601-to-utf8 ksc-5601)
-           do (,setter code dest di)
+     (loop with i fixnum = start
+           with di fixnum = d-start
+           while (< i end)
+           for b1 of-type ub8 = (,getter src i)
+           do
+              (if (< b1 #x80)
+                  ;; ASCII passthrough
+                  (progn
+                    (,setter b1 dest di)
+                    (incf i 1)
+                    (incf di 1))
+                  ;; KS C 5601 double-byte
+                  (progn
+                    (when (>= (1+ i) end)
+                      (decoding-error src :ksc_5601 seq i nil 'end-of-input-in-character))
+                    (let* ((b1-offset (- b1 #x80))
+                           (b2-offset (- (,getter src (1+ i)) #x80))
+                           (ksc-5601 (logior (ash b1-offset 8) b2-offset))
+                           (code (ksc-5601-to-utf8 ksc-5601)))
+                      (,setter code dest di))
+                    (incf i 2)
+                    (incf di 1)))
            finally (return (the fixnum (- di d-start))))))

[wsgac]

@aadcg Thanks a lot for raising this and sorry for being sloppy with the tests. Actually, I've already started working on this, but I'll take your suggestions into account.