>From 515afc9c15870cd7bd6b96e2d8b89938116923ac Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 20 Jul 2019 19:40:03 -0700 Subject: [PATCH 6/6] Fix crash if user test munges hash table MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * src/fns.c (restore_mutability) (hash_table_user_defined_call): New functions. (cmpfn_user_defined, hashfn_user_defined): Use them. (make_hash_table, copy_hash_table): Mark new hash table as mutable. (check_mutable_hash_table): New function. (Fclrhash, Fputhash, Fremhash): Use it instead of CHECK_IMPURE. * src/lisp.h (struct hash_table_test): User-defined functions now take pointers to struct Lisp_Hash_Table, not to struct hash_table_test. All uses changed. (struct Lisp_Hash_Table): New member ‘mutable’. * src/pdumper.c (dump_hash_table): Copy it. * test/src/fns-tests.el (test-hash-function-that-mutates-hash-table): New test, which tests for the bug. --- src/alloc.c | 1 + src/bytecode.c | 5 ++- src/composite.c | 2 +- src/fns.c | 74 ++++++++++++++++++++++++++++++++----------- src/lisp.h | 15 ++++++--- src/pdumper.c | 1 + src/profiler.c | 8 ++--- test/src/fns-tests.el | 12 +++++++ 8 files changed, 87 insertions(+), 31 deletions(-) diff --git a/src/alloc.c b/src/alloc.c index 09b3a4ea7e..1718ce0faf 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5352,6 +5352,7 @@ purecopy_hash_table (struct Lisp_Hash_Table *table) pure->count = table->count; pure->next_free = table->next_free; pure->purecopy = table->purecopy; + eassert (!pure->mutable); pure->rehash_threshold = table->rehash_threshold; pure->rehash_size = table->rehash_size; pure->key_and_value = purecopy (table->key_and_value); diff --git a/src/bytecode.c b/src/bytecode.c index e82de026a8..d668a9a6a1 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1410,14 +1410,13 @@ #define DEFINE(name, value) LABEL (name) , { /* Do a linear search if there are not many cases FIXME: 5 is arbitrarily chosen. */ Lisp_Object hash_code - = h->test.cmpfn ? h->test.hashfn (v1, &h->test) : Qnil; + = h->test.cmpfn ? h->test.hashfn (v1, h) : Qnil; for (i = h->count; 0 <= --i; ) if (EQ (v1, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) - && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), - &h->test)))) + && !NILP (h->test.cmpfn (v1, HASH_KEY (h, i), h)))) break; } else diff --git a/src/composite.c b/src/composite.c index c36663f8e9..a6606d5fc4 100644 --- a/src/composite.c +++ b/src/composite.c @@ -655,7 +655,7 @@ composition_gstring_put_cache (Lisp_Object gstring, ptrdiff_t len) struct Lisp_Hash_Table *h = XHASH_TABLE (gstring_hash_table); hash_rehash_if_needed (h); Lisp_Object header = LGSTRING_HEADER (gstring); - Lisp_Object hash = h->test.hashfn (header, &h->test); + Lisp_Object hash = h->test.hashfn (header, h); if (len < 0) { ptrdiff_t glyph_len = LGSTRING_GLYPH_LEN (gstring); diff --git a/src/fns.c b/src/fns.c index d9503c491e..5f1ed07a12 100644 --- a/src/fns.c +++ b/src/fns.c @@ -3931,11 +3931,37 @@ HASH_INDEX (struct Lisp_Hash_Table *h, ptrdiff_t idx) return XFIXNUM (AREF (h->index, idx)); } +/* Restore a hash table's mutability after the critical section exits. */ + +static void +restore_mutability (void *ptr) +{ + struct Lisp_Hash_Table *h = ptr; + h->mutable = true; +} + +/* Return the result of calling a user-defined hash or comparison + function ARGS[0] with arguments ARGS[1] through ARGS[NARGS - 1]. + Signal an error if the function attempts to modify H, which + otherwise might lead to undefined behavior. */ + +static Lisp_Object +hash_table_user_defined_call (ptrdiff_t nargs, Lisp_Object *args, + struct Lisp_Hash_Table *h) +{ + if (!h->mutable) + return Ffuncall (nargs, args); + ptrdiff_t count = inhibit_garbage_collection (); + record_unwind_protect_ptr (restore_mutability, h); + h->mutable = false; + return unbind_to (count, Ffuncall (nargs, args)); +} + /* Ignore HT and compare KEY1 and KEY2 using 'eql'. Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object -cmpfn_eql (Lisp_Object key1, Lisp_Object key2, struct hash_table_test *ht) +cmpfn_eql (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) { return Feql (key1, key2); } @@ -3944,7 +3970,7 @@ cmpfn_eql (Lisp_Object key1, Lisp_Object key2, struct hash_table_test *ht) Value is true if KEY1 and KEY2 are the same. */ static Lisp_Object -cmpfn_equal (Lisp_Object key1, Lisp_Object key2, struct hash_table_test *ht) +cmpfn_equal (Lisp_Object key1, Lisp_Object key2, struct Lisp_Hash_Table *h) { return Fequal (key1, key2); } @@ -3955,16 +3981,17 @@ cmpfn_equal (Lisp_Object key1, Lisp_Object key2, struct hash_table_test *ht) static Lisp_Object cmpfn_user_defined (Lisp_Object key1, Lisp_Object key2, - struct hash_table_test *ht) + struct Lisp_Hash_Table *h) { - return call2 (ht->user_cmp_function, key1, key2); + Lisp_Object args[] = { h->test.user_cmp_function, key1, key2 }; + return hash_table_user_defined_call (ARRAYELTS (args), args, h); } /* Ignore HT and return a hash code for KEY which uses 'eq' to compare keys. */ static Lisp_Object -hashfn_eq (Lisp_Object key, struct hash_table_test *ht) +hashfn_eq (Lisp_Object key, struct Lisp_Hash_Table *h) { return make_fixnum (XHASH (key) ^ XTYPE (key)); } @@ -3973,7 +4000,7 @@ hashfn_eq (Lisp_Object key, struct hash_table_test *ht) The hash code is at most INTMASK. */ Lisp_Object -hashfn_equal (Lisp_Object key, struct hash_table_test *ht) +hashfn_equal (Lisp_Object key, struct Lisp_Hash_Table *h) { return make_fixnum (sxhash (key, 0)); } @@ -3982,19 +4009,19 @@ hashfn_equal (Lisp_Object key, struct hash_table_test *ht) The hash code is at most INTMASK. */ Lisp_Object -hashfn_eql (Lisp_Object key, struct hash_table_test *ht) +hashfn_eql (Lisp_Object key, struct Lisp_Hash_Table *h) { - return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, ht); + return (FLOATP (key) || BIGNUMP (key) ? hashfn_equal : hashfn_eq) (key, h); } /* Given HT, return a hash code for KEY which uses a user-defined function to compare keys. */ static Lisp_Object -hashfn_user_defined (Lisp_Object key, struct hash_table_test *ht) +hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h) { - Lisp_Object hash = call1 (ht->user_hash_function, key); - return hashfn_eq (hash, ht); + Lisp_Object args[] = { h->test.user_hash_function, key }; + return hash_table_user_defined_call (ARRAYELTS (args), args, h); } struct hash_table_test const @@ -4088,6 +4115,7 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->index = make_vector (index_size, make_fixnum (-1)); h->next_weak = NULL; h->purecopy = purecopy; + h->mutable = true; /* Set up the free list. */ for (i = 0; i < size - 1; ++i) @@ -4113,6 +4141,7 @@ copy_hash_table (struct Lisp_Hash_Table *h1) h2 = allocate_hash_table (); *h2 = *h1; + h2->mutable = true; h2->key_and_value = Fcopy_sequence (h1->key_and_value); h2->hash = Fcopy_sequence (h1->hash); h2->next = Fcopy_sequence (h1->next); @@ -4217,7 +4246,7 @@ hash_table_rehash (struct Lisp_Hash_Table *h) if (!NILP (HASH_HASH (h, i))) { Lisp_Object key = HASH_KEY (h, i); - Lisp_Object hash_code = h->test.hashfn (key, &h->test); + Lisp_Object hash_code = h->test.hashfn (key, h); set_hash_hash_slot (h, i, hash_code); } @@ -4255,7 +4284,7 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) hash_rehash_if_needed (h); - Lisp_Object hash_code = h->test.hashfn (key, &h->test); + Lisp_Object hash_code = h->test.hashfn (key, h); if (hash) *hash = hash_code; @@ -4265,12 +4294,19 @@ hash_lookup (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object *hash) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), &h->test)))) + && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) break; return i; } +static void +check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) +{ + if (!h->mutable) + signal_error ("hash table test modifies table", obj); + eassert (!PURE_P (h)); +} /* Put an entry into hash table H that associates KEY with VALUE. HASH is a previously computed hash code of KEY. @@ -4310,7 +4346,7 @@ hash_put (struct Lisp_Hash_Table *h, Lisp_Object key, Lisp_Object value, void hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) { - Lisp_Object hash_code = h->test.hashfn (key, &h->test); + Lisp_Object hash_code = h->test.hashfn (key, h); ptrdiff_t start_of_bucket = XUFIXNUM (hash_code) % ASIZE (h->index); ptrdiff_t prev = -1; @@ -4323,7 +4359,7 @@ hash_remove_from_table (struct Lisp_Hash_Table *h, Lisp_Object key) if (EQ (key, HASH_KEY (h, i)) || (h->test.cmpfn && EQ (hash_code, HASH_HASH (h, i)) - && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), &h->test)))) + && !NILP (h->test.cmpfn (key, HASH_KEY (h, i), h)))) { /* Take entry out of collision chain. */ if (prev < 0) @@ -4912,7 +4948,7 @@ DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, (Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - CHECK_IMPURE (table, h); + check_mutable_hash_table (table, h); hash_clear (h); /* Be compatible with XEmacs. */ return table; @@ -4937,7 +4973,7 @@ DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, (Lisp_Object key, Lisp_Object value, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - CHECK_IMPURE (table, h); + check_mutable_hash_table (table, h); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, key, &hash); @@ -4955,7 +4991,7 @@ DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, (Lisp_Object key, Lisp_Object table) { struct Lisp_Hash_Table *h = check_hash_table (table); - CHECK_IMPURE (table, h); + check_mutable_hash_table (table, h); hash_remove_from_table (h, key); return Qnil; } diff --git a/src/lisp.h b/src/lisp.h index e5edb8fd12..6d101fed90 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2225,6 +2225,8 @@ #define DEFSYM(sym, name) /* empty */ /* The structure of a Lisp hash table. */ +struct Lisp_Hash_Table; + struct hash_table_test { /* Name of the function used to compare keys. */ @@ -2237,10 +2239,10 @@ #define DEFSYM(sym, name) /* empty */ Lisp_Object user_cmp_function; /* C function to compare two keys. */ - Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct hash_table_test *t); + Lisp_Object (*cmpfn) (Lisp_Object, Lisp_Object, struct Lisp_Hash_Table *); /* C function to compute hash code. */ - Lisp_Object (*hashfn) (Lisp_Object, struct hash_table_test *t); + Lisp_Object (*hashfn) (Lisp_Object, struct Lisp_Hash_Table *); }; struct Lisp_Hash_Table @@ -2289,6 +2291,11 @@ #define DEFSYM(sym, name) /* empty */ changed afterwards. */ bool purecopy; + /* True if the table is mutable. Ordinarily tables are mutable, but + pure tables are not, and while a table is being mutated it is + immutable for recursive attempts to mutate it. */ + bool mutable; + /* Resize hash table when number of entries / table size is >= this ratio. */ float rehash_threshold; @@ -3591,8 +3598,8 @@ #define CONS_TO_INTEGER(cons, type, var) \ extern char *extract_data_from_object (Lisp_Object, ptrdiff_t *, ptrdiff_t *); EMACS_UINT hash_string (char const *, ptrdiff_t); EMACS_UINT sxhash (Lisp_Object, int); -Lisp_Object hashfn_eql (Lisp_Object, struct hash_table_test *); -Lisp_Object hashfn_equal (Lisp_Object, struct hash_table_test *); +Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); +Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, Lisp_Object, bool); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); diff --git a/src/pdumper.c b/src/pdumper.c index 206a196890..2abac80a37 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2742,6 +2742,7 @@ dump_hash_table (struct dump_context *ctx, DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, next_free); DUMP_FIELD_COPY (out, hash, purecopy); + DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, rehash_threshold); DUMP_FIELD_COPY (out, hash, rehash_size); dump_field_lv (ctx, out, hash, &hash->key_and_value, WEIGHT_STRONG); diff --git a/src/profiler.c b/src/profiler.c index e9b6a37d06..ed0e9ddd88 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -37,8 +37,8 @@ saturated_add (EMACS_INT a, EMACS_INT b) typedef struct Lisp_Hash_Table log_t; static Lisp_Object cmpfn_profiler (Lisp_Object, Lisp_Object, - struct hash_table_test *); -static Lisp_Object hashfn_profiler (Lisp_Object, struct hash_table_test *); + struct Lisp_Hash_Table *); +static Lisp_Object hashfn_profiler (Lisp_Object, struct Lisp_Hash_Table *); static const struct hash_table_test hashtest_profiler = { @@ -528,7 +528,7 @@ DEFUN ("function-equal", Ffunction_equal, Sfunction_equal, 2, 2, 0, } static Lisp_Object -cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct hash_table_test *t) +cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct Lisp_Hash_Table *h) { if (VECTORP (bt1) && VECTORP (bt2)) { @@ -545,7 +545,7 @@ cmpfn_profiler (Lisp_Object bt1, Lisp_Object bt2, struct hash_table_test *t) } static Lisp_Object -hashfn_profiler (Lisp_Object bt, struct hash_table_test *ht) +hashfn_profiler (Lisp_Object bt, struct Lisp_Hash_Table *h) { EMACS_UINT hash; if (VECTORP (bt)) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index 9d4ae4fdf3..7d56da77cf 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -846,4 +846,16 @@ test-proper-list-p (should (not (proper-list-p (make-bool-vector 0 nil)))) (should (not (proper-list-p (make-symbol "a"))))) +(ert-deftest test-hash-function-that-mutates-hash-table () + (define-hash-table-test 'badeq 'eq 'bad-hash) + (let ((h (make-hash-table :test 'badeq :size 1 :rehash-size 1))) + (defun bad-hash (k) + (if (eq k 100) + (clrhash h)) + (sxhash-eq k)) + (should-error + (dotimes (k 200) + (puthash k k h))) + (should (= 100 (hash-table-count h))))) + (provide 'fns-tests) -- 2.17.1