Commit 3e0b94e7 authored by Daniel Colascione's avatar Daniel Colascione

Add set operations for bool-vector.

http://lists.gnu.org/archive/html/emacs-devel/2013-09/msg00404.html

* data.c (Qbool_vector_p): New symbol.
(bool_vector_spare_mask,popcount_size_t_generic)
(popcount_size_t_msc,popcount_size_t_gcc)
(popcount_size_t)
(bool_vector_binop_driver)
(count_trailing_zero_bits,size_t_to_host_endian)
(Fbool_vector_exclusive_or)
(Fbool_vector_union)
(Fbool_vector_intersection,Fbool_vector_set_difference)
(Fbool_vector_subsetp,Fbool_vector_not)
(Fbool_vector_count_matches)
(Fbool_vector_count_matches_at): New functions.
(syms_of_data): Intern new symbol, functions.
* alloc.c (bool_vector_payload_bytes): New function.
(Fmake_bool_vector): Instead of calling Fmake_vector,
which performs redundant initialization and argument checking,
just call allocate_vector ourselves.  Make sure we clear any
terminating padding to zero.
(vector_nbytes,sweep_vectors): Use bool_vector_payload_bytes
instead of open-coding the size calculation.
(vroundup_ct): New macro.
(vroundup): Assume argument >= 0; invoke vroundup_ct.
* casetab.c (shuffle,set_identity): Change lint_assume to assume.
* composite.c (composition_gstring_put_cache): Change
lint_assume to assume.
* conf_post.h (assume): New macro.
(lint_assume): Remove.
* dispnew.c (update_frame_1): Change lint_assume to assume.
* ftfont.c (ftfont_shape_by_flt): Change lint_assume
to assume.
* image.c (gif_load): Change lint_assume to assume.
* lisp.h (eassert_and_assume): New macro.
(Qbool_vector_p): Declare.
(CHECK_BOOL_VECTOR,ROUNDUP,BITS_PER_SIZE_T): New macros.
(swap16,swap32,swap64): New inline functions.
* macfont.c (macfont_shape): Change lint_assume to assume.
* ralloc.c: Rename ROUNDUP to PAGE_ROUNDUP throughout.
* xsettings.c (parse_settings): Use new swap16 and
swap32 from lisp.h instead of file-specific macros.
parent 76880d88
2013-09-15 Jan Djärv <jan.h.d@swipnet.se>
2013-09-22 Daniel Colascione <dancol@dancol.org>
* NEWS: Mention new bool-vector functionality.
aaaa2013-09-15 Jan Djärv <jan.h.d@swipnet.se>
* NEWS: Mention the macfont backend.
......
......@@ -638,6 +638,16 @@ for something (not just adding elements to it), it ought not to affect you.
* Lisp Changes in Emacs 24.4
** New bool-vector set operation functions:
*** `bool-vector-exclusive-or'
*** `bool-vector-union'
*** `bool-vector-intersection'
*** `bool-vector-set-difference'
*** `bool-vector-not'
*** `bool-vector-subset'
*** `bool-vector-count-matches'
*** `bool-vector-count-matches-at'
** Comparison functions =, <, >, <=, >= now take many arguments.
** The second argument of `eval' can now be a lexical-environment.
......
2013-09-22 Daniel Colascione <dancol@dancol.org>
* data.c (Qbool_vector_p): New symbol.
(bool_vector_spare_mask,popcount_size_t_generic)
(popcount_size_t_msc,popcount_size_t_gcc)
(popcount_size_t)
(bool_vector_binop_driver)
(count_trailing_zero_bits,size_t_to_host_endian)
(Fbool_vector_exclusive_or)
(Fbool_vector_union)
(Fbool_vector_intersection,Fbool_vector_set_difference)
(Fbool_vector_subsetp,Fbool_vector_not)
(Fbool_vector_count_matches)
(Fbool_vector_count_matches_at): New functions.
(syms_of_data): Intern new symbol, functions.
* alloc.c (bool_vector_payload_bytes): New function.
(Fmake_bool_vector): Instead of calling Fmake_vector,
which performs redundant initialization and argument checking,
just call allocate_vector ourselves. Make sure we clear any
terminating padding to zero.
(vector_nbytes,sweep_vectors): Use bool_vector_payload_bytes
instead of open-coding the size calculation.
(vroundup_ct): New macro.
(vroundup): Assume argument >= 0; invoke vroundup_ct.
* casetab.c (shuffle,set_identity): Change lint_assume to assume.
* composite.c (composition_gstring_put_cache): Change
lint_assume to assume.
* conf_post.h (assume): New macro.
(lint_assume): Remove.
* dispnew.c (update_frame_1): Change lint_assume to assume.
* ftfont.c (ftfont_shape_by_flt): Change lint_assume
to assume.
* image.c (gif_load): Change lint_assume to assume.
* lisp.h (eassert_and_assume): New macro.
(Qbool_vector_p): Declare.
(CHECK_BOOL_VECTOR,ROUNDUP,BITS_PER_SIZE_T): New macros.
(swap16,swap32,swap64): New inline functions.
* macfont.c (macfont_shape): Change lint_assume to assume.
* ralloc.c: Rename ROUNDUP to PAGE_ROUNDUP throughout.
* xsettings.c (parse_settings): Use new swap16 and
swap32 from lisp.h instead of file-specific macros.
2013-09-22 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (try_window_id): Don't abort if cursor row could not be
......
......@@ -2001,6 +2001,35 @@ INIT must be an integer that represents a character. */)
return val;
}
verify (sizeof (size_t) * CHAR_BIT == BITS_PER_SIZE_T);
verify ((BITS_PER_SIZE_T & (BITS_PER_SIZE_T - 1)) == 0);
static
ptrdiff_t
bool_vector_payload_bytes (ptrdiff_t nr_bits,
ptrdiff_t* exact_needed_bytes_out)
{
ptrdiff_t exact_needed_bytes;
ptrdiff_t needed_bytes;
eassert_and_assume (nr_bits >= 0);
exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT;
needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_SIZE_T) / CHAR_BIT;
if (needed_bytes == 0)
{
/* Always allocate at least one machine word of payload so that
bool-vector operations in data.c don't need a special case
for empty vectors. */
needed_bytes = sizeof (size_t);
}
if (exact_needed_bytes_out != NULL)
*exact_needed_bytes_out = exact_needed_bytes;
return needed_bytes;
}
DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
......@@ -2009,37 +2038,43 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
{
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
ptrdiff_t length_in_chars;
EMACS_INT length_in_elts;
int bits_per_value;
int extra_bool_elts = ((bool_header_size - header_size + word_size - 1)
/ word_size);
ptrdiff_t exact_payload_bytes;
ptrdiff_t total_payload_bytes;
ptrdiff_t needed_elements;
CHECK_NATNUM (length);
if (PTRDIFF_MAX < XFASTINT (length))
memory_full (SIZE_MAX);
bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
total_payload_bytes = bool_vector_payload_bytes
(XFASTINT (length), &exact_payload_bytes);
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
eassert_and_assume (exact_payload_bytes <= total_payload_bytes);
eassert_and_assume (0 <= exact_payload_bytes);
val = Fmake_vector (make_number (length_in_elts + extra_bool_elts), Qnil);
needed_elements = ROUNDUP ((size_t) ((bool_header_size - header_size)
+ total_payload_bytes),
word_size) / word_size;
/* No Lisp_Object to trace in there. */
p = (struct Lisp_Bool_Vector* ) allocate_vector (needed_elements);
XSETVECTOR (val, p);
XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
if (length_in_chars)
if (exact_payload_bytes)
{
memset (p->data, ! NILP (init) ? -1 : 0, length_in_chars);
memset (p->data, ! NILP (init) ? -1 : 0, exact_payload_bytes);
/* Clear any extraneous bits in the last byte. */
p->data[length_in_chars - 1]
p->data[exact_payload_bytes - 1]
&= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
}
/* Clear padding at the end. */
memset (p->data + exact_payload_bytes,
0,
total_payload_bytes - exact_payload_bytes);
return val;
}
......@@ -2565,24 +2600,22 @@ enum
roundup_size = COMMON_MULTIPLE (word_size, USE_LSB_TAG ? GCALIGNMENT : 1)
};
/* ROUNDUP_SIZE must be a power of 2. */
verify ((roundup_size & (roundup_size - 1)) == 0);
/* Verify assumptions described above. */
verify ((VECTOR_BLOCK_SIZE % roundup_size) == 0);
verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Round up X to nearest mult-of-ROUNDUP_SIZE. */
#define vroundup(x) (((x) + (roundup_size - 1)) & ~(roundup_size - 1))
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */
#define vroundup_ct(x) ROUNDUP((size_t)(x), roundup_size)
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime. */
#define vroundup(x) (assume((x) >= 0), vroundup_ct(x))
/* Rounding helps to maintain alignment constraints if USE_LSB_TAG. */
#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup (sizeof (void *)))
#define VECTOR_BLOCK_BYTES (VECTOR_BLOCK_SIZE - vroundup_ct (sizeof (void *)))
/* Size of the minimal vector allocated from block. */
#define VBLOCK_BYTES_MIN vroundup (header_size + sizeof (Lisp_Object))
#define VBLOCK_BYTES_MIN vroundup_ct (header_size + sizeof (Lisp_Object))
/* Size of the largest vector allocated from block. */
......@@ -2642,7 +2675,7 @@ struct large_vector
struct large_vector *vector;
#if USE_LSB_TAG
/* We need to maintain ROUNDUP_SIZE alignment for the vector member. */
unsigned char c[vroundup (sizeof (struct large_vector *))];
unsigned char c[vroundup_ct (sizeof (struct large_vector *))];
#endif
} next;
struct Lisp_Vector v;
......@@ -2783,10 +2816,14 @@ vector_nbytes (struct Lisp_Vector *v)
if (size & PSEUDOVECTOR_FLAG)
{
if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
size = (bool_header_size
+ (((struct Lisp_Bool_Vector *) v)->size
+ BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR);
{
struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v;
ptrdiff_t payload_bytes =
bool_vector_payload_bytes (bv->size, NULL);
eassert_and_assume (payload_bytes >= 0);
size = bool_header_size + ROUNDUP (payload_bytes, word_size);
}
else
size = (header_size
+ ((size & PSEUDOVECTOR_SIZE_MASK)
......@@ -2886,17 +2923,11 @@ sweep_vectors (void)
total_vectors++;
if (vector->header.size & PSEUDOVECTOR_FLAG)
{
struct Lisp_Bool_Vector *b = (struct Lisp_Bool_Vector *) vector;
/* All non-bool pseudovectors are small enough to be allocated
from vector blocks. This code should be redesigned if some
pseudovector type grows beyond VBLOCK_BYTES_MAX. */
eassert (PSEUDOVECTOR_TYPEP (&vector->header, PVEC_BOOL_VECTOR));
total_vector_slots
+= (bool_header_size
+ ((b->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
/ BOOL_VECTOR_BITS_PER_CHAR)) / word_size;
total_vector_slots += vector_nbytes (vector) / word_size;
}
else
total_vector_slots
......
......@@ -205,7 +205,7 @@ set_identity (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
from = to = XINT (c);
to++;
lint_assume (to <= MAX_CHAR + 1);
assume (to <= MAX_CHAR + 1);
for (; from < to; from++)
CHAR_TABLE_SET (table, from, make_number (from));
}
......@@ -232,7 +232,7 @@ shuffle (Lisp_Object table, Lisp_Object c, Lisp_Object elt)
from = to = XINT (c);
to++;
lint_assume (to <= MAX_CHAR + 1);
assume (to <= MAX_CHAR + 1);
for (; from < to; from++)
{
Lisp_Object tem = Faref (table, elt);
......
......@@ -674,7 +674,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len)
len = j;
}
lint_assume (len <= TYPE_MAXIMUM (ptrdiff_t) - 2);
assume (len <= TYPE_MAXIMUM (ptrdiff_t) - 2);
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
......
......@@ -248,16 +248,24 @@ extern void _DebPrint (const char *fmt, ...);
# define FLEXIBLE_ARRAY_MEMBER 1
#endif
/* assume(cond) tells the compiler (and lint) that a certain condition
* will always hold, and that it should optimize (or check) accordingly. */
#if defined lint
# define assume(cond) ((cond) ? (void) 0 : abort ())
#elif (__GNUC__ == 4 && __GNUC_MINOR__ >= 5) || __GNUC__ > 4
# define assume(cond) ((x) || (__builtin_unreachable(), 0))
#elif defined __MSC_VER
# define assume(cond) __assume ((cond))
#else
# define assume(cond) (0 && (cond))
#endif
/* Use this to suppress gcc's `...may be used before initialized' warnings. */
#ifdef lint
/* Use CODE only if lint checking is in effect. */
# define IF_LINT(Code) Code
/* Assume that the expression COND is true. This differs in intent
from 'assert', as it is a message from the programmer to the compiler. */
# define lint_assume(cond) ((cond) ? (void) 0 : abort ())
#else
# define IF_LINT(Code) /* empty */
# define lint_assume(cond) ((void) (0 && (cond)))
#endif
/* conf_post.h ends here */
This diff is collapsed.
......@@ -4451,7 +4451,7 @@ update_frame_1 (struct frame *f, bool force_p, bool inhibit_id_p)
}
}
lint_assume (0 <= FRAME_LINES (f));
assume (0 <= FRAME_LINES (f));
pause_p = 0 < i && i < FRAME_LINES (f) - 1;
/* Now just clean up termcap drivers and set cursor, etc. */
......
......@@ -2425,7 +2425,7 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
}
len = i;
lint_assume (len <= STRING_BYTES_BOUND);
assume (len <= STRING_BYTES_BOUND);
if (with_variation_selector)
{
......
......@@ -7523,7 +7523,7 @@ gif_load (struct frame *f, struct image *img)
{
while (subimg_height <= row)
{
lint_assume (pass < 3);
assume (pass < 3);
row = interlace_start[++pass];
}
......
......@@ -1405,7 +1405,7 @@ offset_intervals (struct buffer *buffer, ptrdiff_t start, ptrdiff_t length)
start, length);
else
{
lint_assume (- TYPE_MAXIMUM (ptrdiff_t) <= length);
assume (- TYPE_MAXIMUM (ptrdiff_t) <= length);
adjust_intervals_for_deletion (buffer, start, -length);
}
}
......
......@@ -131,6 +131,13 @@ extern bool suppress_checking EXTERNALLY_VISIBLE;
? (void) 0 \
: die (# cond, __FILE__, __LINE__))
#endif /* ENABLE_CHECKING */
/* When checking is enabled, identical to eassert. When checking is
* disabled, instruct the compiler (when the compiler has such
* capability) to assume that cond is true and optimize
* accordingly. */
#define eassert_and_assume(cond) (eassert (cond), assume (cond))
/* Use the configure flag --enable-check-lisp-object-type to make
Lisp_Object use a struct type instead of the default int. The flag
......@@ -730,6 +737,7 @@ extern int char_table_translate (Lisp_Object, int);
extern Lisp_Object Qarrayp, Qbufferp, Qbuffer_or_string_p, Qchar_table_p;
extern Lisp_Object Qconsp, Qfloatp, Qintegerp, Qlambda, Qlistp, Qmarkerp, Qnil;
extern Lisp_Object Qnumberp, Qstringp, Qsymbolp, Qvectorp;
extern Lisp_Object Qbool_vector_p;
extern Lisp_Object Qvector_or_char_table_p, Qwholenump;
extern Lisp_Object Qwindow;
extern Lisp_Object Ffboundp (Lisp_Object);
......@@ -2359,6 +2367,11 @@ CHECK_VECTOR (Lisp_Object x)
CHECK_TYPE (VECTORP (x), Qvectorp, x);
}
INLINE void
CHECK_BOOL_VECTOR (Lisp_Object x)
{
CHECK_TYPE (BOOL_VECTOR_P (x), Qbool_vector_p, x);
}
INLINE void
CHECK_VECTOR_OR_STRING (Lisp_Object x)
{
CHECK_TYPE (VECTORP (x) || STRINGP (x), Qarrayp, x);
......@@ -4347,6 +4360,43 @@ functionp (Lisp_Object object)
return 0;
}
INLINE
uint16_t
swap16 (uint16_t val)
{
return (val << 8) | (val & 0xFF);
}
INLINE
uint32_t
swap32 (uint32_t val)
{
uint32_t low = swap16 (val & 0xFFFF);
uint32_t high = swap16 (val >> 16);
return (low << 16) | high;
}
#ifdef UINT64_MAX
INLINE
uint64_t
swap64 (uint64_t val)
{
uint64_t low = swap32 (val & 0xFFFFFFFF);
uint64_t high = swap32 (val >> 32);
return (low << 32) | high;
}
#endif
#if ((SIZE_MAX >> 31) >> 1) & 1
# define BITS_PER_SIZE_T 64
#else
# define BITS_PER_SIZE_T 32
#endif
/* Round x to the next multiple of y. Does not overflow. Evaluates
arguments repeatedly. */
#define ROUNDUP(x,y) ((y)*((x)/(y) + ((x)%(y)!=0)))
INLINE_HEADER_END
#endif /* EMACS_LISP_H */
......@@ -2817,7 +2817,7 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no
}
len = i;
lint_assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
assume (len <= TYPE_MAXIMUM (EMACS_INT) - 2);
if (INT_MAX / 2 < len)
memory_full (SIZE_MAX);
......
......@@ -85,7 +85,7 @@ static int extra_bytes;
/* Macros for rounding. Note that rounding to any value is possible
by changing the definition of PAGE. */
#define PAGE (getpagesize ())
#define ROUNDUP(size) (((size_t) (size) + page_size - 1) \
#define PAGE_ROUNDUP(size) (((size_t) (size) + page_size - 1) \
& ~((size_t) (page_size - 1)))
#define MEM_ALIGN sizeof (double)
......@@ -281,7 +281,7 @@ obtain (void *address, size_t size)
Get some extra, so we can come here less often. */
get = size + extra_bytes - already_available;
get = (char *) ROUNDUP ((char *) last_heap->end + get)
get = (char *) PAGE_ROUNDUP ((char *) last_heap->end + get)
- (char *) last_heap->end;
if (real_morecore (get) != last_heap->end)
......@@ -344,7 +344,7 @@ relinquish (void)
else
{
excess = ((char *) last_heap->end
- (char *) ROUNDUP ((char *) last_heap->end - excess));
- (char *) PAGE_ROUNDUP ((char *) last_heap->end - excess));
/* If the system doesn't want that much memory back, leave
the end of the last heap unchanged to reflect that. This
can occur if break_value is still within the original
......@@ -768,9 +768,9 @@ r_alloc_sbrk (ptrdiff_t size)
not always find a space which is contiguous to the previous. */
void *new_bloc_start;
heap_ptr h = first_heap;
size_t get = ROUNDUP (size);
size_t get = PAGE_ROUNDUP (size);
address = (void *) ROUNDUP (virtual_break_value);
address = (void *) PAGE_ROUNDUP (virtual_break_value);
/* Search the list upward for a heap which is large enough. */
while ((char *) h->end < (char *) MEM_ROUNDUP ((char *) address + get))
......@@ -778,7 +778,7 @@ r_alloc_sbrk (ptrdiff_t size)
h = h->next;
if (h == NIL_HEAP)
break;
address = (void *) ROUNDUP (h->start);
address = (void *) PAGE_ROUNDUP (h->start);
}
/* If not found, obtain more space. */
......@@ -790,9 +790,9 @@ r_alloc_sbrk (ptrdiff_t size)
return 0;
if (first_heap == last_heap)
address = (void *) ROUNDUP (virtual_break_value);
address = (void *) PAGE_ROUNDUP (virtual_break_value);
else
address = (void *) ROUNDUP (last_heap->start);
address = (void *) PAGE_ROUNDUP (last_heap->start);
h = last_heap;
}
......@@ -1054,7 +1054,7 @@ r_alloc_check (void)
for (h = first_heap; h; h = h->next)
{
assert (h->prev == ph);
assert ((void *) ROUNDUP (h->end) == h->end);
assert ((void *) PAGE_ROUNDUP (h->end) == h->end);
#if 0 /* ??? The code in ralloc.c does not really try to ensure
the heap start has any sort of alignment.
Perhaps it should. */
......@@ -1190,7 +1190,7 @@ r_alloc_init (void)
if (break_value == NULL)
emacs_abort ();
extra_bytes = ROUNDUP (50000);
extra_bytes = PAGE_ROUNDUP (50000);
#endif
#ifdef DOUG_LEA_MALLOC
......@@ -1212,7 +1212,7 @@ r_alloc_init (void)
#endif
#ifndef SYSTEM_MALLOC
first_heap->end = (void *) ROUNDUP (first_heap->start);
first_heap->end = (void *) PAGE_ROUNDUP (first_heap->start);
/* The extra call to real_morecore guarantees that the end of the
address space is a multiple of page_size, even if page_size is
......
......@@ -336,9 +336,6 @@ get_prop_window (struct x_display_info *dpyinfo)
XUngrabServer (dpy);
}
#define SWAP32(nr) (((nr) << 24) | (((nr) << 8) & 0xff0000) \
| (((nr) >> 8) & 0xff00) | ((nr) >> 24))
#define SWAP16(nr) (((nr) << 8) | ((nr) >> 8))
#define PAD(nr) (((nr) + 3) & ~3)
/* Parse xsettings and extract those that deal with Xft.
......@@ -408,7 +405,7 @@ parse_settings (unsigned char *prop,
if (bytes < 12) return BadLength;
memcpy (&n_settings, prop+8, 4);
if (my_bo != that_bo) n_settings = SWAP32 (n_settings);
if (my_bo != that_bo) n_settings = swap32 (n_settings);
bytes_parsed = 12;
memset (settings, 0, sizeof (*settings));
......@@ -430,7 +427,7 @@ parse_settings (unsigned char *prop,
memcpy (&nlen, prop+bytes_parsed, 2);
bytes_parsed += 2;
if (my_bo != that_bo) nlen = SWAP16 (nlen);
if (my_bo != that_bo) nlen = swap16 (nlen);
if (bytes_parsed+nlen > bytes) return BadLength;
to_cpy = nlen > 127 ? 127 : nlen;
memcpy (name, prop+bytes_parsed, to_cpy);
......@@ -457,7 +454,7 @@ parse_settings (unsigned char *prop,
if (want_this)
{
memcpy (&ival, prop+bytes_parsed, 4);
if (my_bo != that_bo) ival = SWAP32 (ival);
if (my_bo != that_bo) ival = swap32 (ival);
}
bytes_parsed += 4;
break;
......@@ -466,7 +463,7 @@ parse_settings (unsigned char *prop,
if (bytes_parsed+4 > bytes) return BadLength;
memcpy (&vlen, prop+bytes_parsed, 4);
bytes_parsed += 4;
if (my_bo != that_bo) vlen = SWAP32 (vlen);
if (my_bo != that_bo) vlen = swap32 (vlen);
if (want_this)
{
to_cpy = vlen > 127 ? 127 : vlen;
......
2013-09-22 Daniel Colascione <dancol@dancol.org>
* automated/data-test.el:
(bool-vector-count-matches-all-0-nil)
(bool-vector-count-matches-all-0-t)
(bool-vector-count-matches-1-il,bool-vector-count-matches-1-t)
(bool-vector-count-matches-at,bool-vector-intersection-op)
(bool-vector-union-op,bool-vector-xor-op)
(bool-vector-set-difference-op)
(bool-vector-change-detection,bool-vector-not): New tests.
(mock-bool-vector-count-matches-at)
(test-bool-vector-bv-from-hex-string)
(test-bool-vector-to-hex-string)
(test-bool-vector-count-matches-at-tc)
(test-bool-vector-apply-mock-op)
(test-bool-vector-binop): New helper functions.
(bool-vector-test-vectors): New testcase data.
2013-09-20 Ryan <rct@thompsonclan.org> (tiny change)
* automated/advice-tests.el (advice-test-called-interactively-p-around)
......
......@@ -21,6 +21,9 @@
;;; Code:
(require 'cl-lib)
(eval-when-compile (require 'cl))
(ert-deftest data-tests-= ()
(should-error (=))
(should (= 1))
......@@ -71,5 +74,186 @@
;; Short circuits before getting to bad arg
(should-not (>= 8 9 'foo)))
;;; data-tests.el ends here
;; Bool vector tests. Compactly represent bool vectors as hex
;; strings.
(ert-deftest bool-vector-count-matches-all-0-nil ()
(cl-loop for sz in '(0 45 1 64 9 344)
do (let* ((bv (make-bool-vector sz nil)))
(should
(eql
(bool-vector-count-matches bv nil)
sz)))))
(ert-deftest bool-vector-count-matches-all-0-t ()
(cl-loop for sz in '(0 45 1 64 9 344)
do (let* ((bv (make-bool-vector sz nil)))
(should
(eql
(bool-vector-count-matches bv t)
0)))))
(ert-deftest bool-vector-count-matches-1-nil ()
(let* ((bv (make-bool-vector 45 nil)))
(aset bv 40 t)
(aset bv 0 t)
(should
(eql
(bool-vector-count-matches bv t)
2)))
)
(ert-deftest bool-vector-count-matches-1-t ()
(let* ((bv (make-bool-vector 45 nil)))
(aset bv 40 t)
(aset bv 0 t)
(should
(eql
(bool-vector-count-matches bv nil)
43))))
(defun mock-bool-vector-count-matches-at (a b i)
(loop for i from i below (length a)
while (eq (aref a i) b)
sum 1))
(defun test-bool-vector-bv-from-hex-string (desc)
(let (bv nchars nibbles)
(dolist (c (string-to-list desc))
(push (string-to-number
(char-to-string c)
16)
nibbles))
(setf bv (make-bool-vector (* 4 (length nibbles)) nil))
(let ((i 0))
(dolist (n (nreverse nibbles))
(dotimes (_ 4)
(aset bv i (> (logand 1 n) 0))
(incf i)
(setf n (lsh n -1)))))
bv))
(defun test-bool-vector-to-hex-string (bv)
(let (nibbles (v (cl-coerce bv 'list)))
(while v
(push (logior
(lsh (if (nth 0 v) 1 0) 0)
(lsh (if (nth 1 v) 1 0) 1)
(lsh (if (nth 2 v) 1 0) 2)
(lsh (if (nth 3 v) 1 0) 3))
nibbles)
(setf v (nthcdr 4 v)))
(mapconcat (lambda (n) (format "%X" n))
(nreverse nibbles)
"")))
(defun test-bool-vector-count-matches-at-tc (desc)
"Run a test case for bool-vector-count-matches-at.
DESC is a string describing the test. It is a sequence of
hexadecimal digits describing the bool vector. We exhaustively
test all counts at all possible positions in the vector by
comparing the subr with a much slower lisp implementation."
(let ((bv (test-bool-vector-bv-from-hex-string desc)))
(loop
for lf in '(nil t)
do (loop
for pos from 0 upto (length bv)
for cnt = (mock-bool-vector-count-matches-at bv lf pos)
for rcnt = (bool-vector-count-matches-at bv lf pos)
unless (eql cnt rcnt)
do (error "FAILED testcase %S %3S %3S %3S"
pos lf cnt rcnt)))))
(defconst bool-vector-test-vectors
'(""
"0"
"F"
"0F"
"F0"
"00000000000000000000000000000FFFFF0000000"
"44a50234053fba3340000023444a50234053fba33400000234"
"12341234123456123412346001234123412345612341234600"
"44a50234053fba33400000234"
"1234123412345612341234600"
"44a50234053fba33400000234"