comparison tests/automated/mule-tests.el @ 3690:d6a215ad08b8

[xemacs-hg @ 2006-11-20 19:21:47 by aidan] Eliminate a couple of CCL bugs with control-1 characters.
author aidan
date Mon, 20 Nov 2006 19:21:56 +0000
parents 43b4a54fbf66
children 42e4605ef1de
comparison
equal deleted inserted replaced
3689:844f6af613f6 3690:d6a215ad08b8
398 (encode-coding-string xemacs-character 'escape-quoted))) 398 (encode-coding-string xemacs-character 'escape-quoted)))
399 (Assert (equal (concat "\033%G" utf-8-char) 399 (Assert (equal (concat "\033%G" utf-8-char)
400 (encode-coding-string xemacs-character 'ctext)))))) 400 (encode-coding-string xemacs-character 'ctext))))))
401 401
402 ;;--------------------------------------------------------------- 402 ;;---------------------------------------------------------------
403 ;; Regression test for a couple of CCL-related bugs.
404 ;;---------------------------------------------------------------
405
406 (let ((ccl-vector [0 0 0 0 0 0 0 0 0]))
407 (define-ccl-program ccl-write-two-control-1-chars
408 `(1
409 ((r0 = ,(charset-id 'control-1))
410 (r1 = 0)
411 (write-multibyte-character r0 r1)
412 (r1 = 31)
413 (write-multibyte-character r0 r1)))
414 "CCL program that writes two control-1 multibyte characters.")
415
416 (Assert (equal
417 (ccl-execute-on-string 'ccl-write-two-control-1-chars
418 ccl-vector "")
419 (format "%c%c" (make-char 'control-1 0)
420 (make-char 'control-1 31))))
421
422 (define-ccl-program ccl-unicode-two-control-1-chars
423 `(1
424 ((r0 = ,(charset-id 'control-1))
425 (r1 = 31)
426 (mule-to-unicode r0 r1)
427 (r4 = r0)
428 (r3 = ,(charset-id 'control-1))
429 (r2 = 0)
430 (mule-to-unicode r3 r2)))
431 "CCL program that writes two control-1 UCS code points in r3 and r4")
432
433 ;; Re-initialise the vector, mainly to clear the instruction counter,
434 ;; which is its last element.
435 (setq ccl-vector [0 0 0 0 0 0 0 0 0])
436
437 (ccl-execute-on-string 'ccl-unicode-two-control-1-chars ccl-vector "")
438
439 (Assert (and (eq (aref ccl-vector 3)
440 (encode-char (make-char 'control-1 0) 'ucs))
441 (eq (aref ccl-vector 4)
442 (encode-char (make-char 'control-1 31) 'ucs)))))
443
444 ;;---------------------------------------------------------------
403 ;; Test charset-in-* functions 445 ;; Test charset-in-* functions
404 ;;--------------------------------------------------------------- 446 ;;---------------------------------------------------------------
405 (with-temp-buffer 447 (with-temp-buffer
406 (insert-file-contents (locate-data-file "HELLO")) 448 (insert-file-contents (locate-data-file "HELLO"))
407 ;; #### rewrite robustly, both assume that the tested implementation 449 ;; #### rewrite robustly, both assume that the tested implementation