diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 99344495c04e..81cb722bf4aa 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 009a0d2dd45e..e5e5fcf33773 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 700003438c65..e441faf0bd92 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 05ee2d1be548..df81264908cf 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_immed(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 31834d413117..66e644f6e11e 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_immed(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 08d55e337315..4cb238298fd6 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 35e320482c72..9aeaeed28cc1 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 { @@ -392,7 +407,7 @@ Wterm db_do_read_element(DbUpdateHandle* handle, Sint position); ERTS_GLB_INLINE Eterm db_copy_key(Process* p, DbTable* tb, DbTerm* obj) { Eterm key = GETKEY(tb, obj->tpl); - if IS_CONST(key) return key; + if is_immed(key) return key; else { Uint size = size_object(key); Eterm* hp = HAlloc(p, size); diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 792127131d44..93ed64000be8 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -197,6 +197,13 @@ last/1 and prev/2.

+

Single-step traversal one key at at time, but using + first_lookup/1, + next_lookup/2, + last_lookup/1 and + prev_lookup/2. This is more + efficient when you also need to lookup the objects for the keys.

+

Search with simple match patterns, using match/1/2/3, match_delete/2 and @@ -454,6 +461,20 @@ true + + + Return the first key and object(s) in an ETS table. + +

Similar to first/1 except that + it returns the object(s) along with the key stored in the table. This is equivalent to doing + first/1 followed by a lookup/2. + If the table is empty, '$end_of_table' is returned. +

+

To find subsequent objects in the table, use + next_lookup/2.

+ + + Fold a function over an ETS table. @@ -936,6 +957,21 @@ Error: fun containing local Erlang function calls + + + Return the last key and object in an ETS table of type + ordered_set. + +

Similar to last/1 except that + it returns the object(s) along with the key stored in the table. This is equivalent to doing + last/1 followed by a lookup/2. + If the table is empty, '$end_of_table' is returned. +

+

To find preceding objects in the table, use + prev_lookup/2.

+ + + Return all objects with a specified key in an ETS table. @@ -1482,6 +1518,21 @@ ets:select(Table, MatchSpec), + + + Return the next key and object(s) in an ETS table. + +

Similar to next/2 except that + it returns the object(s) along with the key stored in the table. This is equivalent to doing + next/2 followed by a lookup/2. + If no next key exists, '$end_of_table' is returned. +

+

+ It can be interleaved with next/2 during traversal. +

+ + + Return the previous key in an ETS table of type @@ -1498,6 +1549,22 @@ ets:select(Table, MatchSpec), + + + Return the previous key and object(s) in an ETS table of type + ordered_set. + +

Similar to prev/2 except that + it returns the object(s) along with the key stored in the table. This is equivalent to doing + prev/2 followed by a lookup/2. + If no previous key exists, '$end_of_table' is returned. +

+

+ It can be interleaved with prev/2 during traversal. +

+ + + Rename a named ETS table. @@ -2361,4 +2428,3 @@ true - diff --git a/lib/stdlib/src/erl_stdlib_errors.erl b/lib/stdlib/src/erl_stdlib_errors.erl index 60996113c2d8..926227f1921a 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 54f195a40917..b04de0f7e099 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 d9418b9c13b6..7eaff2406a8b 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 aeda6e4e78b2..2aa692bea73b 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 @@ -288,7 +290,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}]}) @@ -1017,12 +1019,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), @@ -1058,7 +1060,7 @@ inserter(T, Next, Papa) -> _ -> 0 end, - + ets:insert(T, {{Next, self()}}), receive stop -> @@ -1238,7 +1240,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. @@ -1710,7 +1712,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), @@ -2096,7 +2098,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), @@ -2138,7 +2140,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(), @@ -2233,7 +2235,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), @@ -2294,9 +2296,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(). @@ -3191,7 +3193,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)]), @@ -4032,23 +4034,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]), @@ -4084,7 +4086,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}]), @@ -4920,35 +4922,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, @@ -4964,18 +4990,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) @@ -5357,14 +5383,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), @@ -6097,9 +6123,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}]), @@ -7128,11 +7154,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). @@ -7934,7 +7960,7 @@ otp_9423(Config) when is_list(Config) -> case run_smp_workers(InitF, ExecF, FiniF, infinite, 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), @@ -7951,7 +7977,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), @@ -9077,7 +9103,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 @@ -9366,6 +9392,7 @@ error_info(_Config) -> {file2tab, 2}, %Not BIF. {first, ['$Tab']}, + {first_lookup, ['$Tab']}, {foldl, 3}, %Not BIF. {foldr, 3}, %Not BIF. @@ -9410,6 +9437,7 @@ error_info(_Config) -> {is_compiled_ms, [bad_ms], [no_fail, no_table]}, {last, ['$Tab']}, + {last_lookup, ['$Tab']}, {lookup, ['$Tab', no_key], [no_fail]}, @@ -9451,11 +9479,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']}, @@ -10027,6 +10059,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]; @@ -10099,7 +10132,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 -> @@ -10115,12 +10148,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 000000000000..9aa501119e05 --- /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 000000000000..3c16f2658d0d --- /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.