Commit bdebeb77 authored by Eli Zaretskii's avatar Eli Zaretskii
Browse files

Fix emacs-module.c for wide ints

* src/emacs-module.c (lisp_to_value): Compare the produced value
with the original Lisp object, not with the one potentially
converted into a Lisp_Cons.  Fixes assertion violations when
working with integers larger than fit into a 32-bit value.

* modules/mod-test/test.el (mod-test-sum-test): Add tests for
large integers, to test --with-wide-int.
parent b99a34bc
...@@ -42,7 +42,11 @@ ...@@ -42,7 +42,11 @@
(nth 1 descr)))) (nth 1 descr))))
(should (= (nth 2 descr) 3))) (should (= (nth 2 descr) 3)))
(should-error (mod-test-sum "1" 2) :type 'wrong-type-argument) (should-error (mod-test-sum "1" 2) :type 'wrong-type-argument)
(should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)) (should-error (mod-test-sum 1 "2") :type 'wrong-type-argument)
(should (= (mod-test-sum -1 most-positive-fixnum)
(1- most-positive-fixnum)))
(should (= (mod-test-sum 1 most-negative-fixnum)
(1+ most-negative-fixnum))))
(ert-deftest mod-test-sum-docstring () (ert-deftest mod-test-sum-docstring ()
(should (string= (documentation 'mod-test-sum) "Return A + B"))) (should (string= (documentation 'mod-test-sum) "Return A + B")))
......
...@@ -880,44 +880,48 @@ value_to_lisp (emacs_value v) ...@@ -880,44 +880,48 @@ value_to_lisp (emacs_value v)
static emacs_value static emacs_value
lisp_to_value (Lisp_Object o) lisp_to_value (Lisp_Object o)
{ {
EMACS_INT i = XLI (o);
#ifdef WIDE_EMACS_INT #ifdef WIDE_EMACS_INT
/* We need to compress the EMACS_INT into the space of a pointer. /* We need to compress the EMACS_INT into the space of a pointer.
For most objects, this is just a question of shuffling the tags around. For most objects, this is just a question of shuffling the tags around.
But in some cases (e.g. large integers) this can't be done, so we But in some cases (e.g. large integers) this can't be done, so we
should allocate a special object to hold the extra data. */ should allocate a special object to hold the extra data. */
Lisp_Object orig = o;
int tag = XTYPE (o); int tag = XTYPE (o);
switch (tag) switch (tag)
{ {
case_Lisp_Int: case_Lisp_Int:
{ {
EMACS_UINT val = i & VALMASK; EMACS_UINT ui = (EMACS_UINT) XINT (o);
if (val <= (SIZE_MAX >> GCTYPEBITS)) if (ui <= (SIZE_MAX >> GCTYPEBITS))
{ {
size_t tv = (size_t)val; uintptr_t uv = (uintptr_t) ui;
emacs_value v = (emacs_value) ((tv << GCTYPEBITS) | tag); emacs_value v = (emacs_value) ((uv << GCTYPEBITS) | tag);
eassert (EQ (value_to_lisp (v), o)); eassert (EQ (value_to_lisp (v), o));
return v; return v;
} }
else else
o = Fcons (o, ltv_mark); {
o = Fcons (o, ltv_mark);
tag = Lisp_Cons;
}
} /* FALLTHROUGH */ } /* FALLTHROUGH */
default: default:
{ {
void *ptr = XUNTAG (o, tag); void *ptr = XUNTAG (o, tag);
if (((size_t)ptr) & ((1 << GCTYPEBITS) - 1)) if (((uintptr_t)ptr) & ((1 << GCTYPEBITS) - 1))
{ /* Pointer is not properly aligned! */ { /* Pointer is not properly aligned! */
eassert (!CONSP (o)); /* Cons cells have to always be aligned! */ eassert (!CONSP (o)); /* Cons cells have to always be aligned! */
o = Fcons (o, ltv_mark); o = Fcons (o, ltv_mark);
ptr = XUNTAG (o, tag); ptr = XUNTAG (o, tag);
} }
emacs_value v = (emacs_value)(((size_t) ptr) | tag); emacs_value v = (emacs_value) (((uintptr_t) ptr) | tag);
eassert (EQ (value_to_lisp (v), o)); eassert (EQ (value_to_lisp (v), orig));
return v; return v;
} }
} }
#else #else
emacs_value v = (emacs_value)i; emacs_value v = (emacs_value) XLI (o);
/* Check the assumption made elsewhere that Lisp_Object and emacs_value /* Check the assumption made elsewhere that Lisp_Object and emacs_value
share the same underlying bit representation. */ share the same underlying bit representation. */
eassert (v == *(emacs_value*)&o); eassert (v == *(emacs_value*)&o);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment