Mercurial > hg > xemacs-beta
comparison tests/automated/mule-tests.el @ 5107:ae4ddcdf30c0
Test escape-quoted for the range U+0000 to U+00FF.
* automated/mule-tests.el (string character conversion):
Inspired by Ben's patch to fix quoting of specials from C1 controls.
| author | Stephen J. Turnbull <stephen@xemacs.org> |
|---|---|
| date | Sun, 07 Mar 2010 00:32:18 +0900 |
| parents | db2db229ee82 |
| children | 0f66906b6e37 |
comparison
equal
deleted
inserted
replaced
| 5105:d76a51b29d91 | 5107:ae4ddcdf30c0 |
|---|---|
| 371 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) | 371 (string (make-string (* 94 60) (make-char 'greek-iso8859-7 57)))) |
| 372 (loop for j from (1- (length string)) downto 0 do | 372 (loop for j from (1- (length string)) downto 0 do |
| 373 (aset string j (aref ascii-string (mod j 94)))) | 373 (aset string j (aref ascii-string (mod j 94)))) |
| 374 (loop for k in '(0 1 58 59) do | 374 (loop for k in '(0 1 58 59) do |
| 375 (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))) | 375 (Assert-equal (substring string (* 94 k) (* 94 (1+ k))) ascii-string))) |
| 376 | |
| 377 ;;--------------------------------------------------------------- | |
| 378 ;; Test string character conversion | |
| 379 ;;--------------------------------------------------------------- | |
| 380 | |
| 381 ;; #### This should test all coding systems! | |
| 382 | |
| 383 (let ((all-octets (let ((s (make-string 256 ?\000))) | |
| 384 (loop for i from (1- (length s)) downto 0 do | |
| 385 (aset s i (int-char i))) | |
| 386 s)) | |
| 387 (escape-quoted-result (let ((schar '(27 155 142 143 14 15)) | |
| 388 (s (make-string 262 ?\000)) | |
| 389 (pos 0)) | |
| 390 (loop for ord from 0 to 255 do | |
| 391 (when (member ord schar) | |
| 392 (aset s pos ?\033) | |
| 393 (incf pos)) | |
| 394 (aset s pos (int-char ord)) | |
| 395 (incf pos)) | |
| 396 s))) | |
| 397 (Assert (string= (encode-coding-string all-octets 'escape-quoted) | |
| 398 escape-quoted-result))) | |
| 376 | 399 |
| 377 ;;--------------------------------------------------------------- | 400 ;;--------------------------------------------------------------- |
| 378 ;; Test file-system character conversion (and, en passant, file ops) | 401 ;; Test file-system character conversion (and, en passant, file ops) |
| 379 ;;--------------------------------------------------------------- | 402 ;;--------------------------------------------------------------- |
| 380 (let* ((dstroke (make-char 'latin-iso8859-2 80)) | 403 (let* ((dstroke (make-char 'latin-iso8859-2 80)) |