-
-;;; debugging stuff
-#|
-(defmacro show-overflow (&body body)
- `(handler-bind ((octet-buffer-overflow
- (lambda (c)
- (format t "Overflowed with ~S~%" (octet-buffer-overflow-replacement c))
- (finish-output))))
- ,@body))
-
-(defun ub8 (len-or-seq)
- (if (numberp len-or-seq)
- (make-array len-or-seq :element-type '(unsigned-byte 8) :initial-element 0)
- (coerce len-or-seq '(simple-array (unsigned-byte 8) (*)))))
-
-(defun ensure-roundtrip-utf8 ()
- (let ((string (make-string char-code-limit))
- (octets (make-array (* 4 char-code-limit) :element-type '(unsigned-byte 8)))
- (string2 (make-string char-code-limit)))
- (dotimes (i char-code-limit)
- (setf (char string i) (code-char i)))
- (multiple-value-bind (_ octets-length used-chars)
- (string-to-octets* octets string :external-format :utf8)
- (declare (ignore _))
- (assert (= used-chars (length string)))
- (multiple-value-bind (_ string-length used-octets)
- (octets-to-string* string2 octets :external-format :utf8 :end2 octets-length)
- (declare (ignore _))
- (assert (= used-octets octets-length))
- (assert (= string-length (length string)))
- (assert (string= string string2)))))
- t)
-
-(defun ensure-roundtrip-utf8-2 ()
- (let ((string (make-string char-code-limit)))
- (dotimes (i char-code-limit)
- (setf (char string i) (code-char i)))
- (let ((string2
- (octets-to-string (string-to-octets string :external-format :utf8)
- :external-format :utf8)))
- (assert (= (length string2) (length string)))
- (assert (string= string string2))))
- t)
-
-(defun ensure-roundtrip-latin (format)
- (let ((octets (ub8 256))
- (string (make-string 256))
- (octets2 (ub8 256)))
- (dotimes (i 256)
- (setf (aref octets i) i))
- (multiple-value-bind (_ string-length octets-used)
- (octets-to-string* string octets :external-format format)
- (declare (ignore _))
- (assert (= string-length 256))
- (assert (= octets-used 256)))
- (multiple-value-bind (_ octet-length chars-used)
- (string-to-octets* octets2 string :external-format format)
- (declare (ignore _))
- (assert (= octet-length 256))
- (assert (= chars-used 256)))
- (assert (every #'= octets octets2)))
- t)
-
-(defun ensure-roundtrip-latin-2 (format)
- (let ((octets (ub8 256)))
- (dotimes (i 256)
- (setf (aref octets i) i))
- (let* ((str (octets-to-string octets :external-format format))
- (oct2 (string-to-octets str :external-format format)))
- (assert (= (length octets) (length oct2)))
- (assert (every #'= octets oct2))))
- t)
-
-(defun ensure-roundtrip-latin1 ()
- (ensure-roundtrip-latin :latin1))
-
-(defun ensure-roundtrip-latin9 ()
- (ensure-roundtrip-latin :latin9))
-
-(defun ensure-roundtrip-latin1-2 ()
- (ensure-roundtrip-latin-2 :latin1))
-
-(defun ensure-roundtrip-latin9-2 ()
- (ensure-roundtrip-latin-2 :latin9))
-
-(defmacro i&c (form)
- `(handler-case ,form
- (error (c)
- (format *trace-output* "~S: ~A~%" ',form c))))
-
-(defun test-octets ()
- (i&c (ensure-roundtrip-utf8))
- (i&c (ensure-roundtrip-utf8-2))
- (i&c (ensure-roundtrip-latin1))
- (i&c (ensure-roundtrip-latin1-2))
- (i&c (ensure-roundtrip-latin9))
- (i&c (ensure-roundtrip-latin9-2)))
-
-|#