File 5341-add-ets-first-next-last-prev_lookup.patch of Package erlang
From 85fa2065d7320601f1c7b07f90e21113da83aac5 Mon Sep 17 00:00:00 2001
From: "Anshul Mittal (WhatsApp)" <mittalanshul@meta.com>
Date: Fri, 1 Dec 2023 12:52:37 -0800
Subject: [PATCH 1/2] add ets:first/next/last/prev_lookup
---
erts/emulator/beam/bif.tab | 4 +
erts/emulator/beam/erl_db.c | 93 +++++++++++++
erts/emulator/beam/erl_db_catree.c | 71 ++++++++--
erts/emulator/beam/erl_db_hash.c | 70 +++++++++-
erts/emulator/beam/erl_db_tree.c | 103 ++++++++++++--
erts/emulator/beam/erl_db_tree_util.h | 15 ++-
erts/emulator/beam/erl_db_util.h | 15 +++
lib/stdlib/doc/src/ets.xml | 68 +++++++++-
lib/stdlib/src/erl_stdlib_errors.erl | 4 +
lib/stdlib/src/ets.erl | 40 +++++-
lib/stdlib/test/Makefile | 1 +
lib/stdlib/test/ets_SUITE.erl | 141 ++++++++++++--------
lib/stdlib/test/ets_property_test_SUITE.erl | 55 ++++++++
lib/stdlib/test/property_test/ets_prop.erl | 108 +++++++++++++++
14 files changed, 699 insertions(+), 89 deletions(-)
create mode 100644 lib/stdlib/test/ets_property_test_SUITE.erl
create mode 100644 lib/stdlib/test/property_test/ets_prop.erl
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 614e8357c8..a12068c1f8 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -357,6 +357,7 @@ bif ets:delete/1
bif ets:delete/2
bif ets:delete_object/2
bif ets:first/1
+bif ets:first_lookup/1
bif ets:is_compiled_ms/1
bif ets:lookup/2
bif ets:lookup_element/3
@@ -364,6 +365,7 @@ bif ets:lookup_element/4
bif ets:info/1
bif ets:info/2
bif ets:last/1
+bif ets:last_lookup/1
bif ets:match/1
bif ets:match/2
bif ets:match/3
@@ -372,7 +374,9 @@ bif ets:match_object/2
bif ets:match_object/3
bif ets:member/2
bif ets:next/2
+bif ets:next_lookup/2
bif ets:prev/2
+bif ets:prev_lookup/2
bif ets:insert/2
bif ets:insert_new/2
bif ets:rename/2
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 8f5e1a9543..22cc537775 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -1115,6 +1115,29 @@ BIF_RETTYPE ets_first_1(BIF_ALIST_1)
BIF_RET(ret);
}
+/*
+** Returns the first {key, object(s)} in a table
+*/
+BIF_RETTYPE ets_first_lookup_1(BIF_ALIST_1)
+{
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+
+ CHECK_TABLES();
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_first_lookup_1);
+
+ cret = tb->common.meth->db_first_lookup(BIF_P, tb, &ret);
+
+ db_unlock(tb, LCK_READ);
+
+ if (cret != DB_ERROR_NONE) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ BIF_RET(ret);
+}
+
/*
** The next BIF, given a key, return the "next" key
*/
@@ -1138,6 +1161,30 @@ BIF_RETTYPE ets_next_2(BIF_ALIST_2)
BIF_RET(ret);
}
+
+/*
+** The next_lookup BIF, given a key, return the "next" {key, object(s)}
+*/
+BIF_RETTYPE ets_next_lookup_2(BIF_ALIST_2)
+{
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+
+ CHECK_TABLES();
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_next_lookup_2);
+
+ cret = tb->common.meth->db_next_lookup(BIF_P, tb, BIF_ARG_2, &ret);
+
+ db_unlock(tb, LCK_READ);
+
+ if (cret != DB_ERROR_NONE) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ BIF_RET(ret);
+}
+
/*
** Returns the last Key in a table
*/
@@ -1161,6 +1208,29 @@ BIF_RETTYPE ets_last_1(BIF_ALIST_1)
BIF_RET(ret);
}
+/*
+** Returns the last {key, object(s)} in a table
+*/
+BIF_RETTYPE ets_last_lookup_1(BIF_ALIST_1)
+{
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+
+ CHECK_TABLES();
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_last_lookup_1);
+
+ cret = tb->common.meth->db_last_lookup(BIF_P, tb, &ret);
+
+ db_unlock(tb, LCK_READ);
+
+ if (cret != DB_ERROR_NONE) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ BIF_RET(ret);
+}
+
/*
** The prev BIF, given a key, return the "previous" key
*/
@@ -1184,6 +1254,29 @@ BIF_RETTYPE ets_prev_2(BIF_ALIST_2)
BIF_RET(ret);
}
+/*
+** The prev_lookup BIF, given a key, return the "previous" {key, object(s)}
+*/
+BIF_RETTYPE ets_prev_lookup_2(BIF_ALIST_2)
+{
+ DbTable* tb;
+ int cret;
+ Eterm ret;
+
+ CHECK_TABLES();
+
+ DB_BIF_GET_TABLE(tb, DB_READ, LCK_READ, BIF_ets_prev_lookup_2);
+
+ cret = tb->common.meth->db_prev_lookup(BIF_P, tb, BIF_ARG_2, &ret);
+
+ db_unlock(tb, LCK_READ);
+
+ if (cret != DB_ERROR_NONE) {
+ BIF_ERROR(BIF_P, BADARG);
+ }
+ BIF_RET(ret);
+}
+
/*
** take(Tab, Key)
*/
diff --git a/erts/emulator/beam/erl_db_catree.c b/erts/emulator/beam/erl_db_catree.c
index 700003438c..e441faf0bd 100644
--- a/erts/emulator/beam/erl_db_catree.c
+++ b/erts/emulator/beam/erl_db_catree.c
@@ -98,13 +98,22 @@ static SWord do_delete_base_node_cont(DbTableCATree *tb,
/* Method interface functions */
static int db_first_catree(Process *p, DbTable *tbl,
Eterm *ret);
+static int db_first_lookup_catree(Process *p, DbTable *tbl,
+ Eterm *ret);
static int db_next_catree(Process *p, DbTable *tbl,
Eterm key, Eterm *ret);
+static int db_next_lookup_catree(Process *p, DbTable *tbl,
+ Eterm key, Eterm *ret);
static int db_last_catree(Process *p, DbTable *tbl,
Eterm *ret);
+static int db_last_lookup_catree(Process *p, DbTable *tbl,
+ Eterm *ret);
static int db_prev_catree(Process *p, DbTable *tbl,
Eterm key,
Eterm *ret);
+static int db_prev_lookup_catree(Process *p, DbTable *tbl,
+ Eterm key,
+ Eterm *ret);
static int db_put_catree(DbTable *tbl, Eterm obj, int key_clash_fail,
SWord *consumed_reds_p);
static int db_get_catree(Process *p, DbTable *tbl,
@@ -227,7 +236,11 @@ DbTableMethod db_catree =
db_get_dbterm_key_tree_common,
db_get_binary_info_catree,
db_first_catree, /* raw_first same as first */
- db_next_catree /* raw_next same as next */
+ db_next_catree, /* raw_next same as next */
+ db_first_lookup_catree,
+ db_next_lookup_catree,
+ db_last_lookup_catree,
+ db_prev_lookup_catree
};
/*
@@ -1567,7 +1580,7 @@ int db_create_catree(Process *p, DbTable *tbl)
return DB_ERROR_NONE;
}
-static int db_first_catree(Process *p, DbTable *tbl, Eterm *ret)
+static int db_first_catree_common(Process *p, DbTable *tbl, Eterm *ret, Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
TreeDbTerm *root;
CATreeRootIterator iter;
@@ -1580,13 +1593,23 @@ static int db_first_catree(Process *p, DbTable *tbl, Eterm *ret)
root = pp ? *pp : NULL;
}
- result = db_first_tree_common(p, tbl, root, ret, NULL);
+ result = db_first_tree_common(p, tbl, root, ret, NULL, func);
destroy_root_iterator(&iter);
return result;
}
-static int db_next_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+static int db_first_catree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_first_catree_common(p, tbl, ret, db_copy_key_tree);
+}
+
+static int db_first_lookup_catree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_first_catree_common(p, tbl, ret, db_copy_key_and_object_tree);
+}
+
+static int db_next_catree_common(Process *p, DbTable *tbl, Eterm key, Eterm *ret, Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
DbTreeStack stack;
TreeDbTerm * stack_array[STACK_NEED];
@@ -1600,7 +1623,7 @@ static int db_next_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
do {
init_tree_stack(&stack, stack_array, 0);
- result = db_next_tree_common(p, tbl, (rootp ? *rootp : NULL), key, ret, &stack);
+ result = db_next_tree_common(p, tbl, (rootp ? *rootp : NULL), key, ret, &stack, func);
if (result != DB_ERROR_NONE || *ret != am_EOT)
break;
@@ -1611,7 +1634,17 @@ static int db_next_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return result;
}
-static int db_last_catree(Process *p, DbTable *tbl, Eterm *ret)
+static int db_next_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_next_catree_common(p, tbl, key, ret, db_copy_key_tree);
+}
+
+static int db_next_lookup_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_next_catree_common(p, tbl, key, ret, db_copy_key_and_object_tree);
+}
+
+static int db_last_catree_common(Process *p, DbTable *tbl, Eterm *ret, Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
TreeDbTerm *root;
CATreeRootIterator iter;
@@ -1624,13 +1657,23 @@ static int db_last_catree(Process *p, DbTable *tbl, Eterm *ret)
root = pp ? *pp : NULL;
}
- result = db_last_tree_common(p, tbl, root, ret, NULL);
+ result = db_last_tree_common(p, tbl, root, ret, NULL, func);
destroy_root_iterator(&iter);
return result;
}
-static int db_prev_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+static int db_last_catree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_last_catree_common(p, tbl, ret, db_copy_key_tree);
+}
+
+static int db_last_lookup_catree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_last_catree_common(p, tbl, ret, db_copy_key_and_object_tree);
+}
+
+static int db_prev_catree_common(Process *p, DbTable *tbl, Eterm key, Eterm *ret, Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
DbTreeStack stack;
TreeDbTerm * stack_array[STACK_NEED];
@@ -1645,7 +1688,7 @@ static int db_prev_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
do {
init_tree_stack(&stack, stack_array, 0);
result = db_prev_tree_common(p, tbl, (rootp ? *rootp : NULL), key, ret,
- &stack);
+ &stack, func);
if (result != DB_ERROR_NONE || *ret != am_EOT)
break;
rootp = catree_find_prev_root(&iter, NULL);
@@ -1655,6 +1698,16 @@ static int db_prev_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return result;
}
+static int db_prev_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_prev_catree_common(p, tbl, key, ret, db_copy_key_tree);
+}
+
+static int db_prev_lookup_catree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_prev_catree_common(p, tbl, key, ret, db_copy_key_and_object_tree);
+}
+
static int db_put_dbterm_catree(DbTable* tbl,
void* obj,
int key_clash_fail,
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 05ee2d1be5..8997b521d4 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -643,6 +643,8 @@ static void shrink(DbTableHash* tb, int nitems);
static void grow(DbTableHash* tb, int nitems);
static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
Uint sz, DbTableHash*);
+static Eterm get_term_list(Process *p, DbTableHash *tb, Eterm key, HashValue hval,
+ HashDbTerm *b1, HashDbTerm **bend);
static int analyze_pattern(DbTableHash *tb, Eterm pattern,
ExtraMatchValidatorF*, /* Optional callback */
struct mp_info *mpi);
@@ -654,11 +656,20 @@ static int db_first_hash(Process *p,
DbTable *tbl,
Eterm *ret);
+static int db_first_lookup_hash(Process *p,
+ DbTable *tbl,
+ Eterm *ret);
+
static int db_next_hash(Process *p,
DbTable *tbl,
Eterm key,
Eterm *ret);
+static int db_next_lookup_hash(Process *p,
+ DbTable *tbl,
+ Eterm key,
+ Eterm *ret);
+
static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret);
static int db_get_element_hash(Process *p, DbTable *tbl,
@@ -873,7 +884,11 @@ DbTableMethod db_hash =
db_get_dbterm_key_hash,
db_get_binary_info_hash,
db_raw_first_hash,
- db_raw_next_hash
+ db_raw_next_hash,
+ db_first_lookup_hash,
+ db_next_lookup_hash,
+ db_first_lookup_hash, /* last == first */
+ db_next_lookup_hash /* prev == next */
};
#ifdef DEBUG
@@ -1072,7 +1087,32 @@ int db_create_hash(Process *p, DbTable *tbl)
return DB_ERROR_NONE;
}
-static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
+static ERTS_INLINE Eterm db_copy_key_hash(Process* p, DbTable* tbl, HashDbTerm* b)
+{
+ Eterm key = GETKEY(&tbl->common, b->dbterm.tpl);
+ if IS_CONST(key) return key;
+ else {
+ Uint size = size_object(key);
+ Eterm* hp = HAlloc(p, size);
+ Eterm res = copy_struct(key, size, &hp, &MSO(p));
+ ASSERT(EQ(res,key));
+ return res;
+ }
+}
+
+static ERTS_INLINE Eterm db_copy_key_and_objects_hash(Process* p, DbTable* tbl, HashDbTerm* b) {
+ Eterm key = db_copy_key_hash(p, tbl, b);
+ HashValue hval = MAKE_HASH(key);
+ DbTableHash *tb = &tbl->hash;
+ Eterm objects = get_term_list(p, tb, key, hval, b, NULL);
+ Eterm *hp, res;
+ hp = HAlloc(p, 3);
+ res = TUPLE2(hp, key, objects);
+
+ return res;
+}
+
+static int db_first_hash_common(Process *p, DbTable *tbl, Eterm *ret, Eterm (*func)(Process *, DbTable *, HashDbTerm *))
{
DbTableHash *tb = &tbl->hash;
Uint ix = 0;
@@ -1083,7 +1123,7 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
list = next_live(tb, &ix, &lck, list);
if (list != NULL) {
- *ret = db_copy_key(p, tbl, &list->dbterm);
+ *ret = (*func)(p, tbl, list);
RUNLOCK_HASH(lck);
}
else {
@@ -1092,8 +1132,17 @@ static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
return DB_ERROR_NONE;
}
+static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_first_hash_common(p, tbl, ret, db_copy_key_hash);
+}
-static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+static int db_first_lookup_hash(Process *p, DbTable *tbl, Eterm *ret)
+{
+ return db_first_hash_common(p, tbl, ret, db_copy_key_and_objects_hash);
+}
+
+static int db_next_hash_common(Process *p, DbTable *tbl, Eterm key, Eterm *ret, Eterm (*func)(Process *, DbTable *, HashDbTerm *))
{
DbTableHash *tb = &tbl->hash;
HashValue hval;
@@ -1132,12 +1181,23 @@ static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
}
else {
ASSERT(!is_pseudo_deleted(b));
- *ret = db_copy_key(p, tbl, &b->dbterm);
+ *ret = (*func)(p, tbl, b);
RUNLOCK_HASH(lck);
}
return DB_ERROR_NONE;
}
+static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_next_hash_common(p, tbl, key, ret, db_copy_key_hash);
+}
+
+
+static int db_next_lookup_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ return db_next_hash_common(p, tbl, key, ret, db_copy_key_and_objects_hash);
+}
+
struct tmp_uncomp_term {
Eterm term;
ErlOffHeap oh;
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 31834d4131..d409ee9381 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -402,13 +402,22 @@ static BIF_RETTYPE ets_select_reverse(BIF_ALIST_3);
/* Method interface functions */
static int db_first_tree(Process *p, DbTable *tbl,
Eterm *ret);
+static int db_first_lookup_tree(Process *p, DbTable *tbl,
+ Eterm *ret);
static int db_next_tree(Process *p, DbTable *tbl,
Eterm key, Eterm *ret);
+static int db_next_lookup_tree(Process *p, DbTable *tbl,
+ Eterm key, Eterm *ret);
static int db_last_tree(Process *p, DbTable *tbl,
Eterm *ret);
+static int db_last_lookup_tree(Process *p, DbTable *tbl,
+ Eterm *ret);
static int db_prev_tree(Process *p, DbTable *tbl,
Eterm key,
Eterm *ret);
+static int db_prev_lookup_tree(Process *p, DbTable *tbl,
+ Eterm key,
+ Eterm *ret);
static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail, SWord *consumed_reds_p);
static int db_get_tree(Process *p, DbTable *tbl,
Eterm key, Eterm *ret);
@@ -526,7 +535,11 @@ DbTableMethod db_tree =
db_get_dbterm_key_tree_common,
db_get_binary_info_tree,
db_first_tree, /* raw_first same as first */
- db_next_tree /* raw_next same as next */
+ db_next_tree, /* raw_next same as next */
+ db_first_lookup_tree,
+ db_next_lookup_tree,
+ db_last_lookup_tree,
+ db_prev_lookup_tree
};
@@ -558,8 +571,40 @@ int db_create_tree(Process *p, DbTable *tbl)
return DB_ERROR_NONE;
}
+Eterm db_copy_key_tree(Process* p, DbTable* tbl, TreeDbTerm* node)
+{
+ Eterm key = GETKEY(&tbl->common, node->dbterm.tpl);
+ if IS_CONST(key) return key;
+ else {
+ Uint size = size_object(key);
+ Eterm* hp = HAlloc(p, size);
+ Eterm res = copy_struct(key, size, &hp, &MSO(p));
+ ASSERT(EQ(res,key));
+ return res;
+ }
+}
+
+Eterm db_copy_key_and_object_tree(Process* p, DbTable* tbl, TreeDbTerm* node) {
+ Eterm key = db_copy_key_tree(p, tbl, node);
+ Eterm *hp, *hend, copy, object, res;
+
+ // +2 for CONS and +3 for TUPLE2
+ int size = node->dbterm.size + 2 + 3;
+ hp = HAlloc(p, size);
+ hend = hp + size;
+ copy = db_copy_object_from_ets(&tbl->common, &node->dbterm, &hp, &MSO(p));
+ object = CONS(hp, copy, NIL);
+ hp += 2;
+ res = TUPLE2(hp, key, object);
+ hp += 3;
+ HRelease(p,hend,hp);
+
+ return res;
+}
+
int db_first_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
- Eterm *ret, DbTableTree *stack_container)
+ Eterm *ret, DbTableTree *stack_container,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
DbTreeStack* stack;
TreeDbTerm *this;
@@ -581,19 +626,26 @@ int db_first_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
stack->slot = 1;
release_stack(tbl,stack_container,stack);
}
- *ret = db_copy_key(p, tbl, &this->dbterm);
+ *ret = (*func)(p, tbl, this);
return DB_ERROR_NONE;
}
static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
- return db_first_tree_common(p, tbl, tb->root, ret, tb);
+ return db_first_tree_common(p, tbl, tb->root, ret, tb, db_copy_key_tree);
+}
+
+static int db_first_lookup_tree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ return db_first_tree_common(p, tbl, tb->root, ret, tb, db_copy_key_and_object_tree);
}
int db_next_tree_common(Process *p, DbTable *tbl,
TreeDbTerm *root, Eterm key,
- Eterm *ret, DbTreeStack* stack)
+ Eterm *ret, DbTreeStack* stack,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
TreeDbTerm *this;
@@ -604,7 +656,7 @@ int db_next_tree_common(Process *p, DbTable *tbl,
*ret = am_EOT;
return DB_ERROR_NONE;
}
- *ret = db_copy_key(p, tbl, &this->dbterm);
+ *ret = (*func)(p, tbl, this);
return DB_ERROR_NONE;
}
@@ -612,13 +664,23 @@ static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
DbTreeStack* stack = get_any_stack(tbl, tb);
- int ret_val = db_next_tree_common(p, tbl, tb->root, key, ret, stack);
+ int ret_val = db_next_tree_common(p, tbl, tb->root, key, ret, stack, db_copy_key_tree);
+ release_stack(tbl,tb,stack);
+ return ret_val;
+}
+
+static int db_next_lookup_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ DbTreeStack* stack = get_any_stack(tbl, tb);
+ int ret_val = db_next_tree_common(p, tbl, tb->root, key, ret, stack, db_copy_key_and_object_tree);
release_stack(tbl,tb,stack);
return ret_val;
}
int db_last_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
- Eterm *ret, DbTableTree *stack_container)
+ Eterm *ret, DbTableTree *stack_container,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
TreeDbTerm *this;
DbTreeStack* stack;
@@ -641,18 +703,24 @@ int db_last_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
stack->slot = NITEMS_CENTRALIZED(tbl);
release_stack(tbl,stack_container,stack);
}
- *ret = db_copy_key(p, tbl, &this->dbterm);
+ *ret = (*func)(p, tbl, this);
return DB_ERROR_NONE;
}
static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
- return db_last_tree_common(p, tbl, tb->root, ret, tb);
+ return db_last_tree_common(p, tbl, tb->root, ret, tb, db_copy_key_tree);
+}
+
+static int db_last_lookup_tree(Process *p, DbTable *tbl, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ return db_last_tree_common(p, tbl, tb->root, ret, tb, db_copy_key_and_object_tree);
}
int db_prev_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, Eterm key,
- Eterm *ret, DbTreeStack* stack)
+ Eterm *ret, DbTreeStack* stack, Eterm (*func)(Process *, DbTable *, TreeDbTerm *))
{
TreeDbTerm *this;
@@ -663,7 +731,7 @@ int db_prev_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, Eterm key,
*ret = am_EOT;
return DB_ERROR_NONE;
}
- *ret = db_copy_key(p, tbl, &this->dbterm);
+ *ret = (*func)(p, tbl, this);
return DB_ERROR_NONE;
}
@@ -671,7 +739,16 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
{
DbTableTree *tb = &tbl->tree;
DbTreeStack* stack = get_any_stack(tbl, tb);
- int res = db_prev_tree_common(p, tbl, tb->root, key, ret, stack);
+ int res = db_prev_tree_common(p, tbl, tb->root, key, ret, stack, db_copy_key_tree);
+ release_stack(tbl,tb,stack);
+ return res;
+}
+
+static int db_prev_lookup_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
+{
+ DbTableTree *tb = &tbl->tree;
+ DbTreeStack* stack = get_any_stack(tbl, tb);
+ int res = db_prev_tree_common(p, tbl, tb->root, key, ret, stack, db_copy_key_and_object_tree);
release_stack(tbl,tb,stack);
return res;
}
diff --git a/erts/emulator/beam/erl_db_tree_util.h b/erts/emulator/beam/erl_db_tree_util.h
index 08d55e3373..4cb238298f 100644
--- a/erts/emulator/beam/erl_db_tree_util.h
+++ b/erts/emulator/beam/erl_db_tree_util.h
@@ -86,14 +86,18 @@ int tree_balance_left(TreeDbTerm **this);
int tree_balance_right(TreeDbTerm **this);
int db_first_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
- Eterm *ret, DbTableTree *stack_container);
+ Eterm *ret, DbTableTree *stack_container,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *));
int db_next_tree_common(Process *p, DbTable *tbl,
TreeDbTerm *root, Eterm key,
- Eterm *ret, DbTreeStack* stack);
+ Eterm *ret, DbTreeStack* stack,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *));
int db_last_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root,
- Eterm *ret, DbTableTree *stack_container);
+ Eterm *ret, DbTableTree *stack_container,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *));
int db_prev_tree_common(Process *p, DbTable *tbl, TreeDbTerm *root, Eterm key,
- Eterm *ret, DbTreeStack* stack);
+ Eterm *ret, DbTreeStack* stack,
+ Eterm (*func)(Process *, DbTable *, TreeDbTerm *));
int db_put_tree_common(DbTableCommon *tb, TreeDbTerm **root, Eterm obj,
int key_clash_fail, DbTableTree *stack_container);
int db_get_tree_common(Process *p, DbTableCommon *tb, TreeDbTerm *root, Eterm key,
@@ -184,4 +188,7 @@ TreeDbTerm *db_find_tree_node_common(DbTableCommon*, TreeDbTerm *root,
Eterm key);
Eterm db_binary_info_tree_common(Process*, TreeDbTerm*);
+Eterm db_copy_key_tree(Process* p, DbTable* tbl, TreeDbTerm* node);
+Eterm db_copy_key_and_object_tree(Process* p, DbTable* tbl, TreeDbTerm* node);
+
#endif /* _DB_TREE_UTIL_H */
diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h
index 35e320482c..62fb6e742e 100644
--- a/erts/emulator/beam/erl_db_util.h
+++ b/erts/emulator/beam/erl_db_util.h
@@ -256,6 +256,21 @@ typedef struct db_table_method
Only internal use by ets:info(_,binary) */
int (*db_raw_first)(Process*, DbTable*, Eterm* ret);
int (*db_raw_next)(Process*, DbTable*, Eterm key, Eterm* ret);
+ /* Same as first/last/next/prev, but returns object(s) along with key */
+ int (*db_first_lookup)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm* ret /* [out] */);
+ int (*db_next_lookup)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm key, /* [in] */
+ Eterm* ret /* [out] */);
+ int (*db_last_lookup)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm* ret /* [out] */);
+ int (*db_prev_lookup)(Process* p,
+ DbTable* tb, /* [in out] */
+ Eterm key,
+ Eterm* ret);
} DbTableMethod;
typedef struct db_fixation {
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 855f38d2ae..9cc39c9484 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -197,6 +197,13 @@
<seemfa marker="#last/1"><c>last/1</c></seemfa> and
<seemfa marker="#prev/2"><c>prev/2</c></seemfa>.</p>
</item>
+ <item><p><em>Single-step</em> traversal one key at at time, but using
+ <seemfa marker="#first_lookup/1"><c>first_lookup/1</c></seemfa>,
+ <seemfa marker="#next_lookup/2"><c>next_lookup/2</c></seemfa>,
+ <seemfa marker="#last_lookup/1"><c>last_lookup/1</c></seemfa> and
+ <seemfa marker="#prev_lookup/2"><c>prev_lookup/2</c></seemfa>. This is more
+ efficient when you also need to lookup the objects for the keys.</p>
+ </item>
<item><p>Search with simple <em>match patterns</em>, using
<seemfa marker="#match/1"><c>match/1/2/3</c></seemfa>,
<seemfa marker="#match_delete/2"><c>match_delete/2</c></seemfa> and
@@ -454,6 +461,20 @@ true
</desc>
</func>
+ <func>
+ <name name="first_lookup" arity="1" since=""/>
+ <fsummary>Return the first key and object(s) in an ETS table.</fsummary>
+ <desc>
+ <p>Similar to <seemfa marker="#first/1"><c>first/1</c></seemfa> except that
+ it returns the object(s) along with the key stored in the table. This is equivalent to doing
+ <seemfa marker="#first/1"><c>first/1</c></seemfa> followed by a <seemfa marker="#lookup/2"><c>lookup/2</c></seemfa>.
+ If the table is empty, <c>'$end_of_table'</c> is returned.
+ </p>
+ <p>To find subsequent objects in the table, use
+ <seemfa marker="#next_lookup/2"><c>next_lookup/2</c></seemfa>.</p>
+ </desc>
+ </func>
+
<func>
<name name="foldl" arity="3" since=""/>
<fsummary>Fold a function over an ETS table.</fsummary>
@@ -936,6 +957,21 @@ Error: fun containing local Erlang function calls
</desc>
</func>
+ <func>
+ <name name="last_lookup" arity="1" since=""/>
+ <fsummary>Return the last key and object in an ETS table of type
+ <c>ordered_set</c>.</fsummary>
+ <desc>
+ <p>Similar to <seemfa marker="#last/1"><c>last/1</c></seemfa> except that
+ it returns the object(s) along with the key stored in the table. This is equivalent to doing
+ <seemfa marker="#last/1"><c>last/1</c></seemfa> followed by a <seemfa marker="#lookup/2"><c>lookup/2</c></seemfa>.
+ If the table is empty, <c>'$end_of_table'</c> is returned.
+ </p>
+ <p>To find preceding objects in the table, use
+ <seemfa marker="#prev_lookup/2"><c>prev_lookup/2</c></seemfa>.</p>
+ </desc>
+ </func>
+
<func>
<name name="lookup" arity="2" since=""/>
<fsummary>Return all objects with a specified key in an ETS table.
@@ -1482,6 +1518,21 @@ ets:select(Table, MatchSpec),</code>
</desc>
</func>
+ <func>
+ <name name="next_lookup" arity="2" since=""/>
+ <fsummary>Return the next key and object(s) in an ETS table.</fsummary>
+ <desc>
+ <p>Similar to <seemfa marker="#next/2"><c>next/2</c></seemfa> except that
+ it returns the object(s) along with the key stored in the table. This is equivalent to doing
+ <seemfa marker="#next/2"><c>next/2</c></seemfa> followed by a <seemfa marker="#lookup/2"><c>lookup/2</c></seemfa>.
+ If no next key exists, <c>'$end_of_table'</c> is returned.
+ </p>
+ <p>
+ It can be interleaved with <seemfa marker="#next/2"><c>next/2</c></seemfa> during traversal.
+ </p>
+ </desc>
+ </func>
+
<func>
<name name="prev" arity="2" since=""/>
<fsummary>Return the previous key in an ETS table of type
@@ -1498,6 +1549,22 @@ ets:select(Table, MatchSpec),</code>
</desc>
</func>
+ <func>
+ <name name="prev_lookup" arity="2" since=""/>
+ <fsummary>Return the previous key and object(s) in an ETS table of type
+ <c>ordered_set</c>.</fsummary>
+ <desc>
+ <p>Similar to <seemfa marker="#prev/2"><c>prev/2</c></seemfa> except that
+ it returns the object(s) along with the key stored in the table. This is equivalent to doing
+ <seemfa marker="#prev/2"><c>prev/2</c></seemfa> followed by a <seemfa marker="#lookup/2"><c>lookup/2</c></seemfa>.
+ If no previous key exists, <c>'$end_of_table'</c> is returned.
+ </p>
+ <p>
+ It can be interleaved with <seemfa marker="#prev/2"><c>prev/2</c></seemfa> during traversal.
+ </p>
+ </desc>
+ </func>
+
<func>
<name name="rename" arity="2" since=""/>
<fsummary>Rename a named ETS table.</fsummary>
@@ -2351,4 +2418,3 @@ true</pre>
</func>
</funcs>
</erlref>
-
diff --git a/lib/stdlib/src/erl_stdlib_errors.erl b/lib/stdlib/src/erl_stdlib_errors.erl
index a90d6477a7..bea2ae8042 100644
--- a/lib/stdlib/src/erl_stdlib_errors.erl
+++ b/lib/stdlib/src/erl_stdlib_errors.erl
@@ -665,6 +665,8 @@ format_ets_error(match_spec_compile, [_], _Cause) ->
[bad_matchspec];
format_ets_error(next, Args, Cause) ->
format_default(bad_key, Args, Cause);
+format_ets_error(next_lookup, Args, Cause) ->
+ format_default(bad_key, Args, Cause);
format_ets_error(new, [Name,Options], Cause) ->
NameError = if
is_atom(Name) -> [];
@@ -681,6 +683,8 @@ format_ets_error(new, [Name,Options], Cause) ->
end;
format_ets_error(prev, Args, Cause) ->
format_default(bad_key, Args, Cause);
+format_ets_error(prev_lookup, Args, Cause) ->
+ format_default(bad_key, Args, Cause);
format_ets_error(rename, [_,NewName]=Args, Cause) ->
case [format_cause(Args, Cause),
if
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 8628a7e29f..f54eca4a3e 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -68,11 +68,11 @@
%%% BIFs
-export([all/0, delete/1, delete/2, delete_all_objects/1,
- delete_object/2, first/1, give_away/3, info/1, info/2,
- insert/2, insert_new/2, is_compiled_ms/1, last/1, lookup/2,
+ delete_object/2, first/1, first_lookup/1, give_away/3, info/1, info/2,
+ insert/2, insert_new/2, is_compiled_ms/1, last/1, last_lookup/1, lookup/2,
lookup_element/3, lookup_element/4, match/1, match/2, match/3, match_object/1,
match_object/2, match_object/3, match_spec_compile/1,
- match_spec_run_r/3, member/2, new/2, next/2, prev/2,
+ match_spec_run_r/3, member/2, new/2, next/2, next_lookup/2, prev/2, prev_lookup/2,
rename/2, safe_fixtable/2, select/1, select/2, select/3,
select_count/2, select_delete/2, select_replace/2, select_reverse/1,
select_reverse/2, select_reverse/3, setopts/2, slot/2,
@@ -147,6 +147,14 @@ delete_object(_, _) ->
first(_) ->
erlang:nif_error(undef).
+-spec first_lookup(Table) -> {Key, [Object]} | '$end_of_table' when
+ Table :: table(),
+ Key :: term(),
+ Object :: tuple().
+
+first_lookup(_) ->
+ erlang:nif_error(undef).
+
-spec give_away(Table, Pid, GiftData) -> true when
Table :: table(),
Pid :: pid(),
@@ -215,6 +223,14 @@ is_compiled_ms(_) ->
last(_) ->
erlang:nif_error(undef).
+-spec last_lookup(Table) -> {Key, [Object]} | '$end_of_table' when
+ Table :: table(),
+ Key :: term(),
+ Object :: tuple().
+
+last_lookup(_) ->
+ erlang:nif_error(undef).
+
-spec lookup(Table, Key) -> [Object] when
Table :: table(),
Key :: term(),
@@ -343,6 +359,15 @@ new(_, _) ->
next(_, _) ->
erlang:nif_error(undef).
+-spec next_lookup(Table, Key1) -> {Key2, [Object]} | '$end_of_table' when
+ Table :: table(),
+ Key1 :: term(),
+ Key2 :: term(),
+ Object :: tuple().
+
+next_lookup(_, _) ->
+ erlang:nif_error(undef).
+
-spec prev(Table, Key1) -> Key2 | '$end_of_table' when
Table :: table(),
Key1 :: term(),
@@ -351,6 +376,15 @@ next(_, _) ->
prev(_, _) ->
erlang:nif_error(undef).
+-spec prev_lookup(Table, Key1) -> {Key2, [Object]} | '$end_of_table' when
+ Table :: table(),
+ Key1 :: term(),
+ Key2 :: term(),
+ Object :: tuple().
+
+prev_lookup(_, _) ->
+ erlang:nif_error(undef).
+
%% Shadowed by erl_bif_types: ets:rename/2
-spec rename(Table, Name) -> Name when
Table :: table(),
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index d9418b9c13..7eaff2406a 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -37,6 +37,7 @@ MODULES= \
error_info_lib \
error_logger_h_SUITE \
escript_SUITE \
+ ets_property_test_SUITE \
ets_SUITE \
ets_tough_SUITE \
filelib_SUITE \
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 73fd3df43a..20f4ab0d6c 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -30,6 +30,7 @@
evil_delete/1,baddelete/1,match_delete/1,table_leak/1]).
-export([match_delete3/1]).
-export([firstnext/1,firstnext_concurrent/1]).
+-export([firstnext_lookup/1,firstnext_lookup_concurrent/1]).
-export([slot/1]).
-export([hash_clash/1]).
-export([match1/1, match2/1, match_object/1, match_object2/1]).
@@ -142,7 +143,8 @@ suite() ->
all() ->
[{group, new}, {group, insert}, {group, lookup},
- {group, delete}, firstnext, firstnext_concurrent, slot, hash_clash,
+ {group, delete}, firstnext, firstnext_concurrent,
+ firstnext_lookup, firstnext_lookup_concurrent, slot, hash_clash,
{group, match}, t_match_spec_run,
{group, lookup_element}, {group, misc}, {group, files},
{group, heavy}, {group, insert_list}, ordered, ordered_match,
@@ -279,7 +281,7 @@ init_per_group(_GroupName, Config) ->
end_per_group(benchmark, Config) ->
T = proplists:get_value(ets_benchmark_result_summary_tab, Config),
EtsProcess = proplists:get_value(ets_benchmark_result_summary_tab_process, Config),
- Report =
+ Report =
fun(NOfBenchmarksCtr, TotThroughputCtr, Name) ->
NBench = ets:lookup_element(T, NOfBenchmarksCtr, 2),
Average = if
@@ -291,7 +293,7 @@ end_per_group(benchmark, Config) ->
end,
io:format("~p ~p~n", [Name, Average]),
ct_event:notify(
- #event{name = benchmark_data,
+ #event{name = benchmark_data,
data = [{suite,"ets_bench"},
{name, Name},
{value, Average}]})
@@ -1020,12 +1022,12 @@ t_delete_all_objects_do(Opts) ->
Self = self(),
Inserters = [spawn_link(fun() -> inserter(T2, 1, Self) end) || _ <- [1,2,3,4]],
[receive {Ipid, running} -> ok end || Ipid <- Inserters],
-
+
ets:delete_all_objects(T2),
erlang:yield(),
[Ipid ! stop || Ipid <- Inserters],
Result = [receive {Ipid, stopped, Highest} -> {Ipid,Highest} end || Ipid <- Inserters],
-
+
%% Verify unbroken sequences of objects inserted _after_ ets:delete_all_objects.
Sum = lists:foldl(fun({Ipid, Highest}, AccSum) ->
%% ets:fun2ms(fun({{K,Ipid}}) when K =< Highest -> true end),
@@ -1061,7 +1063,7 @@ inserter(T, Next, Papa) ->
_ ->
0
end,
-
+
ets:insert(T, {{Next, self()}}),
receive
stop ->
@@ -1241,7 +1243,7 @@ do_fill_dbag_using_lists(T,0) ->
do_fill_dbag_using_lists(T,N) ->
ets:insert(T,[{N,integer_to_list(N)},
{N + N rem 2,integer_to_list(N + N rem 2)}]),
- do_fill_dbag_using_lists(T,N - 1).
+ do_fill_dbag_using_lists(T,N - 1).
%% Test the insert_new function.
@@ -1713,7 +1715,7 @@ t_select_delete(Config) when is_list(Config) ->
F = case ets:info(Table,type) of
X when X == bag; X == duplicate_bag ->
2;
- _ ->
+ _ ->
1
end,
xfilltabstr(Table, 4000),
@@ -2099,7 +2101,7 @@ t_select_hashmap_term_copy_bug(_Config) ->
V = [LM#{ Key => Dollar1 }]
end, maps:keys(LM)),
-
+
%% Create a hashmap with enough keys before and after the '$1' for it to
%% remain a hashmap when we remove those keys.
LMWithDollar = make_lm_with_dollar(LM#{ '$1' => a }, LargeMapSize, FlatmapSize),
@@ -2141,7 +2143,7 @@ t_select_hashmap_term_copy_bug(_Config) ->
(_, M) when map_size(M) > FlatmapSize ->
M
end, LMWithDollar, lists:reverse(maps:keys(LMWithDollar))),
-
+
%% Test hashmap with a key-value pair that are variable
V3 = ets:select(T, [{{'$1'},[], [LM#{ '$1' => '$1' }]}]),
erlang:garbage_collect(),
@@ -2236,7 +2238,7 @@ match_heavy(Config) when is_list(Config) ->
ok.
%%% Extra safety for the very low probability that this is not
-%%% caught by the random test (Statistically impossible???)
+%%% caught by the random test (Statistically impossible???)
drop_match() ->
EtsMem = etsmem(),
T = build_table([a,b],[a],1500),
@@ -2297,9 +2299,9 @@ random_test() ->
io:format(F,"~p. ~n",[Seed]),
file:close(F),
io:format("Random seed ~p written to ~s, copy to ~s to rerun with "
- "same seed.",[Seed,
+ "same seed.",[Seed,
filename:join([WriteDir, "last_random_seed.txt"]),
- filename:join([ReadDir,
+ filename:join([ReadDir,
"preset_random_seed.txt"])]),
do_random_test().
@@ -3158,7 +3160,7 @@ do_fixtable_iter_bag(T) ->
DelSorted = lists:sort(Deleted),
DelSorted = lists:usort(Deleted), %% No duplicates
NDels = length(Deleted),
-
+
%% Nr of keys where all values were deleted.
NDeletedKeys = lists:sum([factorial(N) || N <- lists:seq(1,MaxValues)]),
@@ -3999,23 +4001,23 @@ pick_all_backwards(T) ->
%% Small test case for both set and bag type ets tables.
setbag(Config) when is_list(Config) ->
EtsMem = etsmem(),
- lists:foreach(fun(SetType) ->
+ lists:foreach(fun(SetType) ->
Set = ets_new(SetType,[SetType]),
Bag = ets_new(bag,[bag]),
Key = {foo,bar},
-
+
%% insert some value
ets:insert(Set,{Key,val1}),
ets:insert(Bag,{Key,val1}),
-
+
%% insert new value for same key again
ets:insert(Set,{Key,val2}),
ets:insert(Bag,{Key,val2}),
-
+
%% check
[{Key,val2}] = ets:lookup(Set,Key),
[{Key,val1},{Key,val2}] = ets:lookup(Bag,Key),
-
+
true = ets:delete(Set),
true = ets:delete(Bag)
end, [set, cat_ord_set,stim_cat_ord_set,ordered_set]),
@@ -4051,7 +4053,7 @@ named(Config) when is_list(Config) ->
%% Test case to check if specified keypos works.
keypos2(Config) when is_list(Config) ->
EtsMem = etsmem(),
- lists:foreach(fun(SetType) ->
+ lists:foreach(fun(SetType) ->
Tab = make_table(foo,
[SetType,{keypos,2}],
[{val,key}, {val2,key}]),
@@ -4887,35 +4889,59 @@ match_delete3_do(Opts) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Test ets:first/1 & ets:next/2.
+
+ets_first_using_first_lookup(Tab) ->
+ case ets:first_lookup(Tab) of
+ '$end_of_table' ->
+ '$end_of_table';
+ {Key, _} ->
+ Key
+ end.
+
+ets_next_using_next_lookup(Tab, Key) ->
+ case ets:next_lookup(Tab, Key) of
+ '$end_of_table' ->
+ '$end_of_table';
+ {Key2, _} ->
+ Key2
+ end.
+
firstnext(Config) when is_list(Config) ->
- repeat_for_opts_all_set_table_types(fun firstnext_do/1).
+ repeat_for_opts_all_set_table_types(
+ fun(Opts) -> firstnext_do(Opts, fun ets:first/1, fun ets:next/2) end).
+
+firstnext_lookup(Config) when is_list(Config) ->
+ repeat_for_opts_all_set_table_types(
+ fun(Opts) -> firstnext_do(Opts, fun ets_first_using_first_lookup/1, fun ets_next_using_next_lookup/2) end).
-firstnext_do(Opts) ->
+firstnext_do(Opts, FirstKeyFun, NextKeyFun) ->
EtsMem = etsmem(),
Tab = ets_new(foo,Opts),
- [] = firstnext_collect(Tab,ets:first(Tab),[]),
+ [] = firstnext_collect(Tab,FirstKeyFun(Tab),[], NextKeyFun),
fill_tab(Tab,foo),
Len = length(ets:tab2list(Tab)),
- Len = length(firstnext_collect(Tab,ets:first(Tab),[])),
+ Len = length(firstnext_collect(Tab,FirstKeyFun(Tab),[], NextKeyFun)),
true = ets:delete(Tab),
verify_etsmem(EtsMem).
-firstnext_collect(_Tab,'$end_of_table',List) ->
+firstnext_collect(_Tab,'$end_of_table',List, _NextKeyFun) ->
List;
-firstnext_collect(Tab,Key,List) ->
- firstnext_collect(Tab,ets:next(Tab,Key),[Key|List]).
+firstnext_collect(Tab,Key,List, NextKeyFun) ->
+ firstnext_collect(Tab,NextKeyFun(Tab,Key),[Key|List], NextKeyFun).
+firstnext_concurrent(Config) when is_list(Config) ->
+ firstnext_concurrent_do(Config, fun ets:first/1, fun ets:next/2).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+firstnext_lookup_concurrent(Config) when is_list(Config) ->
+ firstnext_concurrent_do(Config, fun ets_first_using_first_lookup/1, fun ets_next_using_next_lookup/2).
-%% Tests ets:first/1 & ets:next/2.
-firstnext_concurrent(Config) when is_list(Config) ->
+firstnext_concurrent_do(Config, FirstKeyFun, NextKeyFun) when is_list(Config) ->
lists:foreach(
- fun(TableType) ->
+ fun(TableType) ->
register(master, self()),
TableName = list_to_atom(atom_to_list(?MODULE) ++ atom_to_list(TableType)),
ets_init(TableName, 20, TableType),
- [dynamic_go(TableName) || _ <- lists:seq(1, 2)],
+ [dynamic_go(TableName, FirstKeyFun, NextKeyFun) || _ <- lists:seq(1, 2)],
receive
after 5000 -> ok
end,
@@ -4931,18 +4957,18 @@ cycle(Tab, L) ->
ets:insert(Tab,list_to_tuple(L)),
cycle(Tab, tl(L)++[hd(L)]).
-dynamic_go(TableName) -> my_spawn_link(fun() -> dynamic_init(TableName) end).
+dynamic_go(TableName, FirstKeyFun, NextKeyFun) -> my_spawn_link(fun() -> dynamic_init(TableName, FirstKeyFun, NextKeyFun) end).
-dynamic_init(TableName) -> [dyn_lookup(TableName) || _ <- lists:seq(1, 10)].
+dynamic_init(TableName, FirstKeyFun, NextKeyFun) -> [dyn_lookup(TableName, FirstKeyFun, NextKeyFun) || _ <- lists:seq(1, 10)].
-dyn_lookup(T) -> dyn_lookup(T, ets:first(T)).
+dyn_lookup(T, FirstKeyFun, NextKeyFun) -> dyn_lookup_next(T, FirstKeyFun(T), NextKeyFun).
-dyn_lookup(_T, '$end_of_table') -> [];
-dyn_lookup(T, K) ->
- NextKey = ets:next(T,K),
- case ets:next(T,K) of
+dyn_lookup_next(_T, '$end_of_table', _NextKeyFun) -> [];
+dyn_lookup_next(T, K, NextKeyFun) ->
+ NextKey = NextKeyFun(T,K),
+ case NextKeyFun(T,K) of
NextKey ->
- dyn_lookup(T, NextKey);
+ dyn_lookup_next(T, NextKey, NextKeyFun);
NK ->
io:fwrite("hmmm... ~p =/= ~p~n", [NextKey,NK]),
exit(failed)
@@ -5324,14 +5350,14 @@ info(Config) when is_list(Config) ->
info_do(Opts) ->
EtsMem = etsmem(),
TableType = lists:foldl(
- fun(Item, Curr) ->
+ fun(Item, Curr) ->
case Item of
set -> set;
ordered_set -> ordered_set;
cat_ord_set -> ordered_set;
stim_cat_ord_set -> ordered_set;
bag -> bag;
- duplicate_bag -> duplicate_bag;
+ duplicate_bag -> duplicate_bag;
_ -> Curr
end
end, set, Opts),
@@ -6064,9 +6090,9 @@ tabfile_ext1_do(Opts,Config) ->
Name = make_ref(),
[ets:insert(T,{X,integer_to_list(X)}) || X <- L],
ok = ets:tab2file(T,FName,[{extended_info,[object_count]}]),
- true = lists:sort(ets:tab2list(T)) =:=
+ true = lists:sort(ets:tab2list(T)) =:=
lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))),
- true = lists:sort(ets:tab2list(T)) =:=
+ true = lists:sort(ets:tab2list(T)) =:=
lists:sort(ets:tab2list(
element(2,ets:file2tab(FName,[{verify,true}])))),
{ok,Name} = disk_log:open([{name,Name},{file,FName}]),
@@ -7095,11 +7121,11 @@ grow_shrink(Config) when is_list(Config) ->
repeat_for_all_set_table_types(
fun(Opts) ->
EtsMem = etsmem(),
-
+
Set = ets_new(a, Opts, 5000),
grow_shrink_0(0, 3071, 3000, 5000, Set),
ets:delete(Set),
-
+
verify_etsmem(EtsMem)
end).
@@ -7901,7 +7927,7 @@ otp_9423(Config) when is_list(Config) ->
case run_smp_workers(InitF, ExecF, FiniF, infinite, #{exclude => 1}) of
Pids when is_list(Pids) ->
%%[P ! start || P <- Pids],
- repeat(fun() -> ets_new(otp_9423, [named_table, public,
+ repeat(fun() -> ets_new(otp_9423, [named_table, public,
{write_concurrency,true}|Opts]),
ets:delete(otp_9423)
end, 10000),
@@ -7918,7 +7944,7 @@ otp_9423(Config) when is_list(Config) ->
%% Corrupted binary in compressed table
otp_10182(Config) when is_list(Config) ->
repeat_for_opts_all_table_types(
- fun(Opts) ->
+ fun(Opts) ->
Bin = <<"aHR0cDovL2hvb3RzdWl0ZS5jb20vYy9wcm8tYWRyb2xsLWFi">>,
Key = {test, Bin},
Value = base64:decode(Bin),
@@ -9044,7 +9070,7 @@ pid_status(Pid) ->
error:undef ->
erts_debug:set_internal_state(available_internal_state, true),
pid_status(Pid)
- end.
+ end.
start_spawn_logger() ->
case whereis(ets_test_spawn_logger) of
@@ -9333,6 +9359,7 @@ error_info(_Config) ->
{file2tab, 2}, %Not BIF.
{first, ['$Tab']},
+ {first_lookup, ['$Tab']},
{foldl, 3}, %Not BIF.
{foldr, 3}, %Not BIF.
@@ -9377,6 +9404,7 @@ error_info(_Config) ->
{is_compiled_ms, [bad_ms], [no_fail, no_table]},
{last, ['$Tab']},
+ {last_lookup, ['$Tab']},
{lookup, ['$Tab', no_key], [no_fail]},
@@ -9418,11 +9446,15 @@ error_info(_Config) ->
%% not exist.
{next, [Set, no_key]},
{prev, [Set, no_key]},
+ {next_lookup, [Set, no_key]},
+ {prev_lookup, [Set, no_key]},
- %% For an ordered set, ets:next/2 and ets:prev/2 succeeds
- %% even if the key does not exist.
+ % For an ordered set, ets:next/2 and ets:prev/2 succeeds
+ % even if the key does not exist.
{next, [OrderedSet, no_key], [no_fail]},
{prev, [OrderedSet, no_key], [no_fail]},
+ {next_lookup, [OrderedSet, no_key], [no_fail]},
+ {prev_lookup, [OrderedSet, no_key], [no_fail]},
{rename, ['$Tab', {bad,name}]},
{rename, [NamedTable, '$named_table']},
@@ -9983,6 +10015,7 @@ repeat_for_opts(F, [Atom | Tail], AccList) when is_atom(Atom) ->
repeat_for_opts(F, [repeat_for_opts_atom2list(Atom) | Tail ], AccList).
repeat_for_opts_atom2list(set_types) -> [set,ordered_set,stim_cat_ord_set,cat_ord_set];
+repeat_for_opts_atom2list(hash_types) -> [set,bag,duplicate_bag];
repeat_for_opts_atom2list(ord_set_types) -> [ordered_set,stim_cat_ord_set,cat_ord_set];
repeat_for_opts_atom2list(all_types) -> [set,ordered_set,stim_cat_ord_set,cat_ord_set,bag,duplicate_bag];
repeat_for_opts_atom2list(all_non_stim_types) -> [set,ordered_set,cat_ord_set,bag,duplicate_bag];
@@ -10055,7 +10088,7 @@ ets_new(Name, Opts0, KeyRange, KeyFun) ->
{erlang:system_info(schedulers) > 1,false, false, []},
Opts0),
Opts = lists:reverse(RevOpts),
- EtsNewHelper =
+ EtsNewHelper =
fun (UseOpts) ->
case get(ets_new_opts) of
UseOpts ->
@@ -10071,12 +10104,12 @@ ets_new(Name, Opts0, KeyRange, KeyFun) ->
(not lists:member(private, Opts)) andalso
(not lists:member(protected, Opts)) of
true ->
- NewOpts1 =
+ NewOpts1 =
case lists:member({write_concurrency, true}, Opts) of
true -> Opts;
false -> [{write_concurrency, true}|Opts]
end,
- NewOpts2 =
+ NewOpts2 =
case lists:member(public, NewOpts1) of
true -> NewOpts1;
false -> [public|NewOpts1]
diff --git a/lib/stdlib/test/ets_property_test_SUITE.erl b/lib/stdlib/test/ets_property_test_SUITE.erl
new file mode 100644
index 0000000000..9aa501119e
--- /dev/null
+++ b/lib/stdlib/test/ets_property_test_SUITE.erl
@@ -0,0 +1,55 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2021-2022. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ets_property_test_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+-compile(export_all).
+-compile(nowarn_export_all).
+
+all() -> [
+ first_case,
+ next_case,
+ last_case,
+ prev_case
+ ].
+
+init_per_suite(Config) ->
+ ct_property_test:init_per_suite(Config).
+
+end_per_suite(Config) ->
+ Config.
+
+first_case(Config) ->
+ do_proptest(prop_first, Config).
+
+next_case(Config) ->
+ do_proptest(prop_next, Config).
+
+last_case(Config) ->
+ do_proptest(prop_last, Config).
+
+prev_case(Config) ->
+ do_proptest(prop_prev, Config).
+
+do_proptest(Prop, Config) ->
+ ct_property_test:quickcheck(
+ ets_prop:Prop(),
+ Config).
diff --git a/lib/stdlib/test/property_test/ets_prop.erl b/lib/stdlib/test/property_test/ets_prop.erl
new file mode 100644
index 0000000000..3c16f2658d
--- /dev/null
+++ b/lib/stdlib/test/property_test/ets_prop.erl
@@ -0,0 +1,108 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2021-2022. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(ets_prop).
+
+-include_lib("common_test/include/ct_property_test.hrl").
+
+-type table_type() :: set | ordered_set | bag | duplicate_bag.
+
+-define(ETS_TAB_DATA, proper_types:list({ct_proper_ext:safe_any(), ct_proper_ext:safe_any()})).
+
+%%%%%%%%%%%%%%%%%%
+%%% Properties %%%
+%%%%%%%%%%%%%%%%%%
+
+%% --- first/2 ----------------------------------------------------------
+prop_first() ->
+ ?FORALL(Type, noshrink(table_type()),
+ ?FORALL(
+ DataList,
+ ?ETS_TAB_DATA,
+ compare_with_and_without_lookup_variants(
+ Type, DataList,
+ fun (T, _) -> ets:first(T) end,
+ fun (T, _) -> ets:first_lookup(T) end)
+ )).
+
+%% --- next/2 ----------------------------------------------------------
+prop_next() ->
+ ?FORALL(Type, noshrink(table_type()),
+ ?FORALL(
+ DataList,
+ ?ETS_TAB_DATA,
+ compare_with_and_without_lookup_variants(
+ Type, DataList, fun ets:next/2, fun ets:next_lookup/2)
+ )).
+
+%% --- last/2 ----------------------------------------------------------
+prop_last() ->
+ ?FORALL(Type, noshrink(table_type()),
+ ?FORALL(
+ DataList,
+ ?ETS_TAB_DATA,
+ compare_with_and_without_lookup_variants(
+ Type, DataList,
+ fun (T, _) -> ets:last(T) end,
+ fun (T, _) -> ets:last_lookup(T) end)
+ )).
+
+%% --- prev/2 ----------------------------------------------------------
+prop_prev() ->
+ ?FORALL(Type, noshrink(table_type()),
+ ?FORALL(
+ DataList,
+ ?ETS_TAB_DATA,
+ compare_with_and_without_lookup_variants(
+ Type, DataList, fun ets:prev/2, fun ets:prev_lookup/2)
+ )).
+
+%%%% helpers %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+random_key([]) ->
+ '$end_of_table';
+random_key([{Key, _}]) ->
+ Key;
+random_key(Data) ->
+ RandomN = 1 + erlang:phash2(erlang:unique_integer(), length(Data)),
+ {Key, _} = lists:nth(RandomN, Data),
+ Key.
+
+compare_with_and_without_lookup_variants(TableType, TableData, WithoutLookupFun, LookupFun) ->
+ Tab = ets:new(test, [TableType]),
+ ets:insert(Tab, TableData),
+ Res = do_compare_with_and_without_lookup_variants(
+ random_key(TableData), Tab, WithoutLookupFun, LookupFun),
+ ets:delete(Tab),
+ Res.
+
+% compare variants of first/next/last/prev with and without _lookup to make sure they are consistent
+% Key is the current position in the table, used for prev/next and ignored for first/last
+% Key = '$end_of_table' means nothing to compare
+do_compare_with_and_without_lookup_variants('$end_of_table', _Tab, _WithoutLookupFun, _LookupFun) ->
+ true;
+do_compare_with_and_without_lookup_variants(Key, Tab, WithoutLookupFun, LookupFun) ->
+ Key2 = WithoutLookupFun(Tab, Key),
+ case Key2 of
+ '$end_of_table' ->
+ '$end_of_table' =:= LookupFun(Tab, Key);
+ _ ->
+ Values2 = ets:lookup(Tab, Key2),
+ {Key2, Values2} =:= LookupFun(Tab, Key)
+ end.
--
2.35.3
