Fix return value for CCL opcode lookup-integer
* src/ccl.c (ccl_driver): Fix LookupIntConstTbl return value. * test/lisp/international/ccl-tests.el (ccl-hash-table): Add test. * lisp/international/ccl.el (ccl-embed-data): Don't pass non-numbers to `ccl-fixnum' (bug#36740).
This commit is contained in:
parent
a415179b56
commit
19ee08f1e8
3 changed files with 21 additions and 3 deletions
|
@ -196,7 +196,9 @@
|
|||
"Embed integer DATA in `ccl-program-vector' at `ccl-current-ic' and
|
||||
increment it. If IC is specified, embed DATA at IC."
|
||||
(if ic
|
||||
(aset ccl-program-vector ic (ccl-fixnum data))
|
||||
(aset ccl-program-vector ic (if (numberp data)
|
||||
(ccl-fixnum data)
|
||||
data))
|
||||
(let ((len (length ccl-program-vector)))
|
||||
(if (>= ccl-current-ic len)
|
||||
(let ((new (make-vector (* len 2) nil)))
|
||||
|
@ -204,7 +206,9 @@ increment it. If IC is specified, embed DATA at IC."
|
|||
(setq len (1- len))
|
||||
(aset new len (aref ccl-program-vector len)))
|
||||
(setq ccl-program-vector new))))
|
||||
(aset ccl-program-vector ccl-current-ic (ccl-fixnum data))
|
||||
(aset ccl-program-vector ccl-current-ic (if (numberp data)
|
||||
(ccl-fixnum data)
|
||||
data))
|
||||
(setq ccl-current-ic (1+ ccl-current-ic))))
|
||||
|
||||
(defun ccl-embed-symbol (symbol prop)
|
||||
|
|
|
@ -1374,7 +1374,7 @@ ccl_driver (struct ccl_program *ccl, int *source, int *destination, int src_size
|
|||
if (! (IN_INT_RANGE (eop) && CHARACTERP (opl)))
|
||||
CCL_INVALID_CMD;
|
||||
reg[RRR] = charset_unicode;
|
||||
reg[rrr] = eop;
|
||||
reg[rrr] = XFIXNUM (opl);
|
||||
reg[7] = 1; /* r7 true for success */
|
||||
}
|
||||
else
|
||||
|
|
|
@ -232,3 +232,17 @@ At EOF:
|
|||
(with-temp-buffer
|
||||
(ccl-dump prog-midi-code)
|
||||
(should (equal (buffer-string) prog-midi-dump))))
|
||||
|
||||
(ert-deftest ccl-hash-table ()
|
||||
(let ((sym (gensym))
|
||||
(table (make-hash-table :test 'eq)))
|
||||
(puthash 16 17 table)
|
||||
(puthash 17 16 table)
|
||||
(define-translation-hash-table sym table)
|
||||
(let* ((prog `(2
|
||||
((loop
|
||||
(lookup-integer ,sym r0 r1)))))
|
||||
(compiled (ccl-compile prog))
|
||||
(registers [17 0 0 0 0 0 0 0]))
|
||||
(ccl-execute compiled registers)
|
||||
(should (equal registers [2 16 0 0 0 0 0 1])))))
|
||||
|
|
Loading…
Add table
Reference in a new issue