File 1032-erts-Remove-deprecated-creator-pid-from-funs.patch of Package erlang
From aef9de493883b03eadf00aabda505563ef515057 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?John=20H=C3=B6gberg?= <john@erlang.org>
Date: Mon, 22 May 2023 18:24:38 +0200
Subject: [PATCH 2/2] erts: Remove deprecated "creator pid" from funs
To stay backwards compatible for another release, erlang:fun_info/1
will return the pid of the `init` process.
---
erts/emulator/beam/copy.c | 190 ++--
erts/emulator/beam/emu/emu_load.c | 5 +-
erts/emulator/beam/erl_bif_info.c | 2 +-
erts/emulator/beam/erl_fun.c | 4 +-
erts/emulator/beam/erl_fun.h | 10 +-
erts/emulator/beam/erl_gc.h | 2 +-
erts/emulator/beam/erl_process_dump.c | 1 -
erts/emulator/beam/erl_term.h | 2 +-
erts/emulator/beam/external.c | 17 +-
erts/emulator/beam/generators.tab | 2 +-
erts/emulator/beam/jit/asm_load.c | 5 +-
erts/emulator/test/erts_debug_SUITE.erl | 2 +-
erts/emulator/test/fun_SUITE.erl | 8 +-
.../emulator/test/trace_call_memory_SUITE.erl | 2 +-
lib/stdlib/test/lists_SUITE.erl | 845 +-----------------
15 files changed, 141 insertions(+), 956 deletions(-)
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index a22317f6c1..5a5ca58bcf 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -139,20 +139,24 @@ Uint size_object_x(Eterm obj, erts_literal_area_t *litopt)
break;
case FUN_SUBTAG:
{
- Eterm* bptr = fun_val(obj);
- ErlFunThing* funp = (ErlFunThing *) bptr;
- unsigned eterms = 1 /* creator */ + funp->num_free;
- unsigned sz = thing_arityval(hdr);
- sum += 1 /* header */ + sz + eterms;
- bptr += 1 /* header */ + sz;
- while (eterms-- > 1) {
- obj = *bptr++;
- if (!IS_CONST(obj)) {
- ESTACK_PUSH(s, obj);
- }
- }
- obj = *bptr;
- break;
+ const ErlFunThing* funp = (ErlFunThing*)fun_val(obj);
+
+ ASSERT(ERL_FUN_SIZE == (1 + thing_arityval(hdr)));
+ sum += ERL_FUN_SIZE + funp->num_free;
+
+ for (int i = 1; i < funp->num_free; i++) {
+ obj = funp->env[i];
+ if (!IS_CONST(obj)) {
+ ESTACK_PUSH(s, obj);
+ }
+ }
+
+ if (funp->num_free > 0) {
+ obj = funp->env[0];
+ break;
+ }
+
+ goto pop_next;
}
case MAP_SUBTAG:
switch (MAP_HEADER_TYPE(hdr)) {
@@ -389,17 +393,18 @@ Uint size_shared(Eterm obj)
goto pop_next;
}
case FUN_SUBTAG: {
- ErlFunThing* funp = (ErlFunThing *) ptr;
- unsigned eterms = 1 /* creator */ + funp->num_free;
- unsigned sz = thing_arityval(hdr);
- sum += 1 /* header */ + sz + eterms;
- ptr += 1 /* header */ + sz;
- while (eterms-- > 0) {
- obj = *ptr++;
- if (!IS_CONST(obj)) {
- EQUEUE_PUT(s, obj);
- }
- }
+ const ErlFunThing* funp = (ErlFunThing *) ptr;
+
+ ASSERT(ERL_FUN_SIZE == (1 + thing_arityval(hdr)));
+ sum += ERL_FUN_SIZE + funp->num_free;
+
+ for (int i = 0; i < funp->num_free; i++) {
+ obj = funp->env[i];
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+
goto pop_next;
}
case SUB_BINARY_SUBTAG: {
@@ -551,16 +556,14 @@ cleanup:
goto cleanup_next;
}
case FUN_SUBTAG: {
- ErlFunThing* funp = (ErlFunThing *) ptr;
- unsigned eterms = 1 /* creator */ + funp->num_free;
- unsigned sz = thing_arityval(hdr);
- ptr += 1 /* header */ + sz;
- while (eterms-- > 0) {
- obj = *ptr++;
- if (!IS_CONST(obj)) {
- EQUEUE_PUT_UNCHECKED(s, obj);
- }
- }
+ const ErlFunThing *funp = (ErlFunThing *) ptr;
+
+ for (int i = 0; i < funp->num_free; i++) {
+ obj = funp->env[i];
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ }
+ }
goto cleanup_next;
}
case MAP_SUBTAG:
@@ -865,24 +868,26 @@ Eterm copy_struct_x(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap,
break;
case FUN_SUBTAG:
{
- ErlFunThing* funp = (ErlFunThing *) objp;
+ const ErlFunThing *src_fun = (const ErlFunThing *)objp;
+ ErlFunThing *dst_fun = (ErlFunThing *)htop;
- i = thing_arityval(hdr) + 2 + funp->num_free;
- tp = htop;
- while (i--) {
- *htop++ = *objp++;
- }
- funp = (ErlFunThing *) tp;
+ *dst_fun = *src_fun;
- if (is_local_fun(funp)) {
- funp->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*) funp;
- erts_refc_inc(&funp->entry.fun->refc, 2);
- } else {
- ASSERT(is_external_fun(funp) && funp->next == NULL);
+ for (int i = 0; i < src_fun->num_free; i++) {
+ dst_fun->env[i] = src_fun->env[i];
}
- *argp = make_fun(tp);
+ ASSERT(&htop[ERL_FUN_SIZE] == &dst_fun->env[0]);
+ htop = &dst_fun->env[dst_fun->num_free];
+ *argp = make_fun(dst_fun);
+
+ if (is_local_fun(dst_fun)) {
+ dst_fun->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*)dst_fun;
+ erts_refc_inc(&dst_fun->entry.fun->refc, 2);
+ } else {
+ ASSERT(is_external_fun(dst_fun) && dst_fun->next == NULL);
+ }
}
break;
case EXTERNAL_PID_SUBTAG:
@@ -1117,7 +1122,6 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info)
{
Uint sum;
Uint e;
- unsigned sz;
Eterm* ptr;
Eterm *lit_purge_ptr = info->lit_purge_ptr;
Uint lit_purge_sz = info->lit_purge_sz;
@@ -1259,17 +1263,18 @@ Uint copy_shared_calculate(Eterm obj, erts_shcopy_t *info)
goto pop_next;
}
case FUN_SUBTAG: {
- ErlFunThing* funp = (ErlFunThing *) ptr;
- unsigned eterms = 1 /* creator */ + funp->num_free;
- sz = thing_arityval(hdr);
- sum += 1 /* header */ + sz + eterms;
- ptr += 1 /* header */ + sz;
- while (eterms-- > 0) {
- obj = *ptr++;
- if (!IS_CONST(obj)) {
- EQUEUE_PUT(s, obj);
- }
- }
+ const ErlFunThing* funp = (ErlFunThing *) ptr;
+
+ ASSERT(ERL_FUN_SIZE == (1 + thing_arityval(hdr)));
+ sum += ERL_FUN_SIZE + funp->num_free;
+
+ for (int i = 0; i < funp->num_free; i++) {
+ obj = funp->env[i];
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT(s, obj);
+ }
+ }
+
goto pop_next;
}
case SUB_BINARY_SUBTAG: {
@@ -1596,32 +1601,36 @@ Uint copy_shared_perform_x(Eterm obj, Uint size, erts_shcopy_t *info,
goto cleanup_next;
}
case FUN_SUBTAG: {
- ErlFunThing* funp = (ErlFunThing *) ptr;
- unsigned eterms = 1 /* creator */ + funp->num_free;
- sz = thing_arityval(hdr);
- funp = (ErlFunThing *) hp;
- *resp = make_fun(hp);
- *hp++ = hdr;
- ptr++;
- while (sz-- > 0) {
- *hp++ = *ptr++;
- }
- while (eterms-- > 0) {
- obj = *ptr++;
- if (IS_CONST(obj)) {
- *hp++ = obj;
- } else {
- EQUEUE_PUT_UNCHECKED(s, obj);
- *hp++ = HEAP_ELEM_TO_BE_FILLED;
- }
- }
+ const ErlFunThing *src_fun = (const ErlFunThing *)ptr;
+ ErlFunThing *dst_fun = (ErlFunThing *)hp;
+
+ *dst_fun = *src_fun;
+
+ /* The header of the source fun may have been clobbered,
+ * restore it. */
+ dst_fun->thing_word = hdr;
- if (is_local_fun(funp)) {
- funp->next = off_heap->first;
- off_heap->first = (struct erl_off_heap_header*) funp;
- erts_refc_inc(&funp->entry.fun->refc, 2);
+ for (int i = 0; i < src_fun->num_free; i++) {
+ obj = src_fun->env[i];
+
+ if (!IS_CONST(obj)) {
+ EQUEUE_PUT_UNCHECKED(s, obj);
+ obj = HEAP_ELEM_TO_BE_FILLED;
+ }
+
+ dst_fun->env[i] = obj;
+ }
+
+ ASSERT(&hp[ERL_FUN_SIZE] == &dst_fun->env[0]);
+ hp = &dst_fun->env[dst_fun->num_free];
+ *resp = make_fun(dst_fun);
+
+ if (is_local_fun(dst_fun)) {
+ dst_fun->next = off_heap->first;
+ off_heap->first = (struct erl_off_heap_header*) dst_fun;
+ erts_refc_inc(&dst_fun->entry.fun->refc, 2);
} else {
- ASSERT(is_external_fun(funp) && funp->next == NULL);
+ ASSERT(is_external_fun(dst_fun) && dst_fun->next == NULL);
}
goto cleanup_next;
@@ -1827,10 +1836,11 @@ Uint copy_shared_perform_x(Eterm obj, Uint size, erts_shcopy_t *info,
hscan++;
break;
case FUN_SUBTAG: {
- ErlFunThing* funp = (ErlFunThing *) hscan;
- hscan += 1 + thing_arityval(*hscan);
- remaining = 1 + funp->num_free;
- break;
+ const ErlFunThing* funp = (ErlFunThing *) hscan;
+ ASSERT(ERL_FUN_SIZE == (1 + thing_arityval(*hscan)));
+ hscan += ERL_FUN_SIZE;
+ remaining = funp->num_free;
+ break;
}
case MAP_SUBTAG:
switch (MAP_HEADER_TYPE(*hscan)) {
@@ -2170,7 +2180,7 @@ move_one_frag(Eterm** hpp, ErlHeapFragment* frag, ErlOffHeap* off_heap, int lite
break;
case FUN_SUBTAG:
{
- ErlFunThing *funp = (ErlFunThing*)hdr;
+ const ErlFunThing *funp = (ErlFunThing *) hdr;
if (is_local_fun(funp)) {
hdr->next = off_heap->first;
diff --git a/erts/emulator/beam/emu/emu_load.c b/erts/emulator/beam/emu/emu_load.c
index 8395a87076..9a078410d0 100644
--- a/erts/emulator/beam/emu/emu_load.c
+++ b/erts/emulator/beam/emu/emu_load.c
@@ -665,15 +665,14 @@ void beam_load_finalize_code(LoaderState* stp, struct erl_module_instance* inst_
literal = beamfile_get_literal(&stp->beam,
stp->lambda_literals[i]);
funp = (ErlFunThing *)fun_val(literal);
- ASSERT(funp->creator == am_external);
+ ASSERT(funp->external == 1);
funp->entry.fun = fun_entry;
funp->next = literal_area->off_heap;
literal_area->off_heap = (struct erl_off_heap_header *)funp;
- ASSERT(erts_init_process_id != ERTS_INVALID_PID);
- funp->creator = erts_init_process_id;
+ funp->external = 0;
erts_refc_inc(&fun_entry->refc, 2);
}
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 4ba368ec7c..127fb84330 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -3674,7 +3674,7 @@ fun_info_2(BIF_ALIST_2)
hp = HAlloc(p, 3);
break;
case am_pid:
- val = is_local_fun(funp) ? funp->creator : am_undefined;
+ val = is_local_fun(funp) ? erts_init_process_id : am_undefined;
hp = HAlloc(p, 3);
break;
case am_module:
diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c
index ae6116ec19..cdac196472 100644
--- a/erts/emulator/beam/erl_fun.c
+++ b/erts/emulator/beam/erl_fun.c
@@ -308,7 +308,7 @@ ErlFunThing *erts_new_export_fun_thing(Eterm **hpp, Export *exp, int arity)
funp->next = NULL;
funp->entry.exp = exp;
funp->num_free = 0;
- funp->creator = am_external;
+ funp->external = 1;
funp->arity = arity;
#ifdef DEBUG
@@ -335,7 +335,7 @@ ErlFunThing *erts_new_local_fun_thing(Process *p, ErlFunEntry *fe,
MSO(p).first = (struct erl_off_heap_header*) funp;
funp->entry.fun = fe;
funp->num_free = num_free;
- funp->creator = p->common.id;
+ funp->external = 0;
funp->arity = arity;
#ifdef DEBUG
diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h
index 4c9ff5cda1..05d27da442 100644
--- a/erts/emulator/beam/erl_fun.h
+++ b/erts/emulator/beam/erl_fun.h
@@ -59,10 +59,10 @@ typedef struct erl_fun_thing {
* pointer to improve performance. */
ErtsDispatchable *disp;
- /* Pointer to function entry, valid iff `creator != am_external`.*/
+ /* Pointer to function entry, valid iff `external == 0`.*/
ErlFunEntry *fun;
- /* Pointer to export entry, valid iff `creator == am_external`.*/
+ /* Pointer to export entry, valid iff `external == 1`.*/
Export *exp;
} entry;
@@ -71,14 +71,14 @@ typedef struct erl_fun_thing {
byte arity; /* The _apparent_ arity of the fun. */
byte num_free; /* Number of free variables (in env). */
+ byte external; /* Whether this is an external fun or not */
/* -- The following may be compound Erlang terms ---------------------- */
- Eterm creator; /* Pid of creator process (contains node). */
Eterm env[]; /* Environment (free variables). */
} ErlFunThing;
-#define is_local_fun(FunThing) ((FunThing)->creator != am_external)
-#define is_external_fun(FunThing) ((FunThing)->creator == am_external)
+#define is_local_fun(FunThing) ((FunThing)->external == 0)
+#define is_external_fun(FunThing) ((FunThing)->external != 0)
/* ERL_FUN_SIZE does _not_ include space for the environment which is a
* C99-style flexible array */
diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h
index c1760562c9..2b21f9e7be 100644
--- a/erts/emulator/beam/erl_gc.h
+++ b/erts/emulator/beam/erl_gc.h
@@ -82,7 +82,7 @@ ERTS_GLB_INLINE Eterm* move_boxed(Eterm *ERTS_RESTRICT ptr, Eterm hdr, Eterm **h
if (is_flatmap_header(hdr)) nelts+=flatmap_get_size(ptr) + 1;
else nelts += hashmap_bitcount(MAP_HEADER_VAL(hdr));
break;
- case FUN_SUBTAG: nelts+=((ErlFunThing*)(ptr))->num_free+1; break;
+ case FUN_SUBTAG: nelts+=((ErlFunThing*)(ptr))->num_free; break;
}
gval = make_boxed(htop);
*orig = gval;
diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h
index 03211a6acd..fa06ba5afe 100644
--- a/erts/emulator/beam/erl_term.h
+++ b/erts/emulator/beam/erl_term.h
@@ -387,7 +387,7 @@ _ET_DECLARE_CHECKED(Eterm*,binary_val,Wterm)
#define HEADER_PROC_BIN _make_header(PROC_BIN_SIZE-1,_TAG_HEADER_REFC_BIN)
/* fun objects */
-#define HEADER_FUN _make_header(ERL_FUN_SIZE-2,_TAG_HEADER_FUN)
+#define HEADER_FUN _make_header(ERL_FUN_SIZE-1,_TAG_HEADER_FUN)
#define is_fun_header(x) ((x) == HEADER_FUN)
#define make_fun(x) make_boxed((Eterm*)(x))
#define is_any_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x))))
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 081ce23e49..085d9ba603 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -3893,7 +3893,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
ep = enc_atom(acmp, fe->module, ep, dflags);
ep = enc_term(acmp, make_small(fe->old_index), ep, dflags, off_heap);
ep = enc_term(acmp, make_small(fe->old_uniq), ep, dflags, off_heap);
- ep = enc_pid(acmp, funp->creator, ep, dflags);
+ ep = enc_pid(acmp, erts_init_process_id, ep, dflags);
for (ei = funp->num_free-1; ei >= 0; ei--) {
WSTACK_PUSH2(s, ENC_TERM, (UWord) funp->env[ei]);
@@ -4981,6 +4981,7 @@ dec_term_atom_common:
hp += num_free;
funp->thing_word = HEADER_FUN;
funp->num_free = num_free;
+ funp->external = 0;
*objp = make_fun(funp);
/* Module */
@@ -5006,6 +5007,15 @@ dec_term_atom_common:
}
old_uniq = unsigned_val(temp);
+ /* Creator pid, discarded */
+ if ((ep = dec_term(edep, factory, ep, &temp, NULL,
+ internal_nc)) == NULL) {
+ goto error;
+ }
+ if (!is_pid(temp)) {
+ goto error;
+ }
+
/*
* It is safe to link the fun into the fun list only when
* no more validity tests can fail.
@@ -5024,9 +5034,6 @@ dec_term_atom_common:
funp->env[i] = (Eterm) next;
next = funp->env + i;
}
- /* Creator */
- funp->creator = (Eterm) next;
- next = &(funp->creator);
break;
}
case ATOM_INTERNAL_REF2:
@@ -5586,7 +5593,7 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj,
if (is_local_fun(funp)) {
result += 20+1+1+4; /* New ID + Tag */
result += 4; /* Length field (number of free variables */
- result += encode_pid_size(acmp, funp->creator, dflags);
+ result += encode_pid_size(acmp, erts_init_process_id, dflags);
result += encode_atom_size(acmp, funp->entry.fun->module, dflags);
result += 2 * (1+4); /* Index, Uniq */
if (funp->num_free > 1) {
diff --git a/erts/emulator/beam/generators.tab b/erts/emulator/beam/generators.tab
index a737228c44..ae806e2062 100644
--- a/erts/emulator/beam/generators.tab
+++ b/erts/emulator/beam/generators.tab
@@ -323,7 +323,7 @@ MakeLiteralLambda(Op, Index, DstType, DstVal) {
funp->next = NULL;
funp->arity = entry->arity;
funp->num_free = 0;
- funp->creator = am_external;
+ funp->external = 1;
literal = beamfile_add_literal(&S->beam, make_fun(tmp_hp), 0);
S->lambda_literals[$Index] = literal;
diff --git a/erts/emulator/beam/jit/asm_load.c b/erts/emulator/beam/jit/asm_load.c
index 023f084051..f6e1f1c6ab 100644
--- a/erts/emulator/beam/jit/asm_load.c
+++ b/erts/emulator/beam/jit/asm_load.c
@@ -997,15 +997,14 @@ void beam_load_finalize_code(LoaderState *stp,
literal = beamfile_get_literal(&stp->beam,
stp->lambda_literals[i]);
funp = (ErlFunThing *)fun_val(literal);
- ASSERT(funp->creator == am_external);
+ ASSERT(funp->external == 1);
funp->entry.fun = fun_entry;
funp->next = literal_area->off_heap;
literal_area->off_heap = (struct erl_off_heap_header *)funp;
- ASSERT(erts_init_process_id != ERTS_INVALID_PID);
- funp->creator = erts_init_process_id;
+ funp->external = 0;
erts_refc_inc(&fun_entry->refc, 2);
}
diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 2149eac41b..3240b800d6 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -82,7 +82,7 @@ test_size(Config) when is_list(Config) ->
%% Fun environment size = 0 (the smallest fun possible)
SimplestFun = fun() -> ok end,
- FunSz0 = 5,
+ FunSz0 = 4,
FunSz0 = do_test_size(SimplestFun),
%% Fun environment size = 1
diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl
index 0f8e7af926..10cfc53a97 100644
--- a/erts/emulator/test/fun_SUITE.erl
+++ b/erts/emulator/test/fun_SUITE.erl
@@ -838,8 +838,7 @@ id(X) ->
X.
spawn_call(Node, AFun) ->
- Parent = self(),
- Init = erlang:whereis(init),
+ Self = self(),
Pid = spawn_link(Node,
fun() ->
receive
@@ -850,10 +849,7 @@ spawn_call(Node, AFun) ->
_ -> lists:seq(0, Arity-1)
end,
Res = apply(Fun, Args),
- case erlang:fun_info(Fun, pid) of
- {pid,Init} -> Parent ! {result,Res};
- {pid,Creator} -> Creator ! {result,Res}
- end
+ Self ! {result,Res}
end
end),
Pid ! {AFun,AFun,AFun},
diff --git a/erts/emulator/test/trace_call_memory_SUITE.erl b/erts/emulator/test/trace_call_memory_SUITE.erl
index 59d1873e49..a18dbdabf1 100644
--- a/erts/emulator/test/trace_call_memory_SUITE.erl
+++ b/erts/emulator/test/trace_call_memory_SUITE.erl
@@ -309,7 +309,7 @@ spawn_memory_lambda(Config) when is_list(Config) ->
receive {'DOWN', MRef, process, Pid, _} -> ok end,
1 = erlang:trace(self(), false, [all]),
%% 16-elements list translates into 34-words for spawn, and 6 more words for apply itself
- {call_memory, [{Pid, 1, 40}]} = erlang:trace_info({erlang, apply, 2}, call_memory).
+ {call_memory, [{Pid, 1, 39}]} = erlang:trace_info({erlang, apply, 2}, call_memory).
spawn_memory_internal(Array) ->
Array.
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index 59f2e8bd03..7a73e1bc82 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -39,20 +39,14 @@
sublist_2/1, sublist_3/1, sublist_2_e/1, sublist_3_e/1,
flatten_1/1, flatten_2/1, flatten_1_e/1, flatten_2_e/1,
dropwhile/1, takewhile/1,
- sort_1/1, sort_2/1, sort_stable/1, merge/1, rmerge/1, sort_rand/1,
- usort_1/1, usort_2/1, usort_stable/1, umerge/1, rumerge/1,usort_rand/1,
+ sort_1/1, sort_2/1, merge/1, rmerge/1, sort_rand/1,
+ usort_1/1, usort_2/1, umerge/1, rumerge/1,usort_rand/1,
keymerge/1, rkeymerge/1,
- keysort_1/1, keysort_i/1, keysort_stable/1,
+ keysort_1/1, keysort_i/1,
keysort_rand/1, keysort_error/1,
ukeymerge/1, rukeymerge/1,
- ukeysort_1/1, ukeysort_i/1, ukeysort_stable/1,
+ ukeysort_1/1, ukeysort_i/1,
ukeysort_rand/1, ukeysort_error/1,
- funmerge/1, rfunmerge/1,
- funsort_1/1, funsort_stable/1, funsort_rand/1,
- funsort_error/1,
- ufunmerge/1, rufunmerge/1,
- ufunsort_1/1, ufunsort_stable/1, ufunsort_rand/1,
- ufunsort_error/1,
uniq_1/1, uniq_2/1,
zip_unzip/1, zip_unzip3/1, zipwith/1, zipwith3/1,
zip_fail/1, zip_trim/1, zip_pad/1,
@@ -73,9 +67,6 @@
-export([sort_loop/0, sort_loop/1, sloop/1]).
-%% Internal export.
--export([make_fun/1]).
-
%%
%% all/1
%%
@@ -91,8 +82,6 @@ all() ->
{group, keysort},
{group, ukeysort},
{group, uniq},
- {group, funsort},
- {group, ufunsort},
{group, sublist},
{group, flatten},
{group, seq},
@@ -103,22 +92,16 @@ all() ->
groups() ->
[{append, [parallel], [append_1, append_2]},
{usort, [parallel],
- [umerge, rumerge, usort_1, usort_2, usort_rand, usort_stable]},
+ [umerge, rumerge, usort_1, usort_2, usort_rand]},
{keysort, [parallel],
[keymerge, rkeymerge, keysort_1, keysort_rand,
- keysort_i, keysort_stable, keysort_error]},
+ keysort_i, keysort_error]},
{key, [parallel], [keymember, keysearch_keyfind, keystore,
keytake, keyreplace]},
{sort,[parallel],[merge, rmerge, sort_1, sort_2, sort_rand]},
{ukeysort, [parallel],
[ukeymerge, rukeymerge, ukeysort_1, ukeysort_rand,
- ukeysort_i, ukeysort_stable, ukeysort_error]},
- {funsort, [parallel],
- [funmerge, rfunmerge, funsort_1, funsort_stable,
- funsort_error, funsort_rand]},
- {ufunsort, [parallel],
- [ufunmerge, rufunmerge, ufunsort_1, ufunsort_stable,
- ufunsort_error, ufunsort_rand]},
+ ukeysort_i, ukeysort_error]},
{seq, [parallel], [seq_loop, seq_2, seq_3, seq_2_e, seq_3_e]},
{sublist, [parallel],
[sublist_2, sublist_3, sublist_2_e, sublist_3_e]},
@@ -647,21 +630,6 @@ sort_rand(Config) when is_list(Config) ->
ok = check(biglist(10000)),
ok.
-%% sort/1 was really stable for a while - the order of equal elements
-%% was kept - but since the performance suffered a bit, this "feature"
-%% was removed.
-
-%% sort/1 should be stable for equal terms.
-sort_stable(Config) when is_list(Config) ->
- ok = check_stability(bigfunlist(10)),
- ok = check_stability(bigfunlist(100)),
- ok = check_stability(bigfunlist(1000)),
- case erlang:system_info(modified_timing_level) of
- undefined -> ok = check_stability(bigfunlist(10000));
- _ -> ok
- end,
- ok.
-
stable_lists_spec() ->
%% [{SortedList, KeysThatHaveEquals}]
[{[0.0, 0], [0]},
@@ -681,23 +649,6 @@ check_order(A, [B | L]) when A =< B ->
check_order(_A, _L) ->
no.
-%% The check that sort/1 is stable is no longer used.
-%% Equal elements are no longer always kept in order.
-check_stability(L) ->
- S = lists:sort(L),
- LP = explicit_pid(L),
- SP = explicit_pid(S),
- check_sorted(1, 2, LP, SP).
-
-explicit_pid(L) ->
- lists:reverse(expl_pid(L, [])).
-
-expl_pid([{I,F} | T], L) when is_function(F) ->
- expl_pid(T, [{I,fun_pid(F)} | L]);
-expl_pid([], L) ->
- L.
-
-
usort_1(Conf) when is_list(Conf) ->
usort(fun lists:usort/1).
@@ -944,18 +895,6 @@ usort_rand(Config) when is_list(Config) ->
ok = ucheck(ubiglist(10000)),
ok.
-%% usort/1 should keep the first duplicate.
-usort_stable(Config) when is_list(Config) ->
- ok = ucheck_stability(bigfunlist(3)),
- ok = ucheck_stability(bigfunlist(10)),
- ok = ucheck_stability(bigfunlist(100)),
- ok = ucheck_stability(bigfunlist(1000)),
- case erlang:system_info(modified_timing_level) of
- undefined -> ok = ucheck_stability(bigfunlist(10000));
- _ -> ok
- end,
- ok.
-
test_stable_usort(ListsUSort, StableList, Xs) ->
StableUList = ulist(StableList),
StableElements =
@@ -975,13 +914,6 @@ ucheck_order(A, [B | L]) when A < B ->
ucheck_order(_A, _L) ->
no.
-%% Check that usort/1 is stable and correct relative ukeysort/2.
-ucheck_stability(L) ->
- S = no_dups(lsort(L)),
- U = lists:usort(L),
- check_stab(L, U, S, "usort/1", "ukeysort/2").
-
-
%% Key merge two lists.
keymerge(Config) when is_list(Config) ->
@@ -1105,18 +1037,6 @@ keysort_1(Config) when is_list(Config) ->
ok.
-%% keysort should be stable
-keysort_stable(Config) when is_list(Config) ->
- ok = keysort_check(1, [{1,b},{1,c}], [{1,b},{1,c}]),
- ok = keysort_check(1, [{1,c},{1,b}], [{1,c},{1,b}]),
- ok = keysort_check(1,
- [{1,c},{1,b},{2,x},{3,p},{2,a}],
- [{1,c},{1,b},{2,x},{2,a},{3,p}]),
- ok = keysort_check(1,
- [{1,a},{1,b},{1,a},{1,a}],
- [{1,a},{1,b},{1,a},{1,a}]),
- ok.
-
%% Create two variants of tuple lists with keys from StableKeys.
%% The variants are {Key}, and {Key,N++}.
%%
@@ -1373,27 +1293,6 @@ ukeysort_1(Config) when is_list(Config) ->
ok.
-%% ukeysort should keep the first duplicate.
-ukeysort_stable(Config) when is_list(Config) ->
- ok = ukeysort_check(1, [{1,b},{1,c}], [{1,b}]),
- ok = ukeysort_check(1, [{1,c},{1,b}], [{1,c}]),
- ok = ukeysort_check(1,
- [{1,c},{1,b},{2,x},{3,p},{2,a}],
- [{1,c},{2,x},{3,p}]),
-
- ok = ukeysort_check(1, [{1,a},{1,b},{1,b}], [{1,a}]),
- ok = ukeysort_check(1, [{2,a},{1,b},{2,a}], [{1,b},{2,a}]),
-
- ok = ukeysort_check_stability(bigfunlist(3)),
- ok = ukeysort_check_stability(bigfunlist(10)),
- ok = ukeysort_check_stability(bigfunlist(100)),
- ok = ukeysort_check_stability(bigfunlist(1000)),
- case erlang:system_info(modified_timing_level) of
- undefined -> ok = ukeysort_check_stability(bigfunlist(10000));
- _ -> ok
- end,
- ok.
-
%% ukeysort should exit when given bad arguments.
ukeysort_error(Config) when is_list(Config) ->
{'EXIT', _} = (catch lists:ukeysort(0, [{1,b},{1,c}])),
@@ -1438,13 +1337,6 @@ gen_ukeysort_check(I, Input) ->
erlang:error(gen_ukeysort_check)
end.
-%% Used for checking that the first copy is kept.
-ukeysort_check_stability(L) ->
- I = 1,
- U = lists:ukeysort(I, L),
- S = no_dups_keys(lkeysort(I, L), I),
- check_stab(L, U, S, "ukeysort/2", "usort/2").
-
%%% Uniquely keysort a list, check that the returned list is what we
%%% expected, and that it is actually sorted.
ukeysort_check(I, Input, Expected) ->
@@ -1483,395 +1375,6 @@ ukeycompare(I, J, A, B) when A =/= B,
element(J, A) =< element(J, B) ->
ok.
-
-
-%% Merge two lists using a fun.
-funmerge(Config) when is_list(Config) ->
-
- Singleton = id([a, b, c]),
- Two = [1,2],
- Six = [1,2,3,4,5,6],
- F = fun(X, Y) -> X =< Y end,
-
- %% 2-way merge
- [] = lists:merge(F, [], []),
- Two = lists:merge(F, Two, []),
- Two = lists:merge(F, [], Two),
- Six = lists:merge(F, [1,3,5], [2,4,6]),
- Six = lists:merge(F, [2,4,6], [1,3,5]),
- Six = lists:merge(F, [1,2,3], [4,5,6]),
- Six = lists:merge(F, [4,5,6], [1,2,3]),
- Six = lists:merge(F, [1,2,5],[3,4,6]),
- [1,2,3,5,7] = lists:merge(F, [1,3,5,7], [2]),
- [1,2,3,4,5,7] = lists:merge(F, [1,3,5,7], [2,4]),
- [1,2,3,4,5,6,7] = lists:merge(F, [1,3,5,7], [2,4,6]),
- [1,2,3,5,7] = lists:merge(F, [2], [1,3,5,7]),
- [1,2,3,4,5,7] = lists:merge(F, [2,4], [1,3,5,7]),
- [1,2,3,4,5,6,7] = lists:merge(F, [2,4,6], [1,3,5,7]),
-
- F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end,
- [{b,2},{c,11},{c,12},{c,21},{c,22},{e,5}] =
- lists:merge(F2,[{c,11},{c,12},{e,5}], [{b,2},{c,21},{c,22}]),
-
- true = erts_debug:same(Singleton, lists:merge(F, Singleton, [])),
- true = erts_debug:same(Singleton, lists:merge(F, [], Singleton)),
-
- {'EXIT', _} = (catch lists:merge(F, a, b)),
- {'EXIT', _} = (catch lists:merge(F, a, [])),
- {'EXIT', _} = (catch lists:merge(F, [], b)),
- {'EXIT', _} = (catch lists:merge(F, a, [1, 2, 3])),
- {'EXIT', _} = (catch lists:merge(F, [1, 2, 3], b)),
-
- ok.
-
-%% Reverse merge two lists using a fun.
-rfunmerge(Config) when is_list(Config) ->
-
- Singleton = id([a, b, c]),
- Two = [2,1],
- Six = [6,5,4,3,2,1],
- F = fun(X, Y) -> X =< Y end,
-
- %% 2-way reversed merge
- [] = lists:rmerge(F, [], []),
- Two = lists:rmerge(F, Two, []),
- Two = lists:rmerge(F, [], Two),
- Six = lists:rmerge(F, [5,3,1], [6,4,2]),
- Six = lists:rmerge(F, [6,4,2], [5,3,1]),
- Six = lists:rmerge(F, [3,2,1], [6,5,4]),
- Six = lists:rmerge(F, [6,5,4], [3,2,1]),
- Six = lists:rmerge(F, [4,3,2],[6,5,1]),
- [7,6,5,3,1] = lists:rmerge(F, [7,5,3,1], [6]),
- [7,6,5,4,3,1] = lists:rmerge(F, [7,5,3,1], [6,4]),
- [7,6,5,4,3,2,1] = lists:rmerge(F, [7,5,3,1], [6,4,2]),
- [7,5,3,2,1] = lists:rmerge(F, [2], [7,5,3,1]),
- [7,5,4,3,2,1] = lists:rmerge(F, [4,2], [7,5,3,1]),
- [7,6,5,4,3,2,1] = lists:rmerge(F, [6,4,2], [7,5,3,1]),
-
- F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end,
- L1 = [{c,11},{c,12},{e,5}],
- L2 = [{b,2},{c,21},{c,22}],
- true =
- lists:merge(F2, L1, L2) ==
- lists:reverse(lists:rmerge(F2,lists:reverse(L1), lists:reverse(L2))),
-
- true = erts_debug:same(Singleton, lists:rmerge(F, Singleton, [])),
- true = erts_debug:same(Singleton, lists:rmerge(F, [], Singleton)),
-
- {'EXIT', _} = (catch lists:rmerge(F, a, b)),
- {'EXIT', _} = (catch lists:rmerge(F, a, [])),
- {'EXIT', _} = (catch lists:rmerge(F, [], b)),
- {'EXIT', _} = (catch lists:rmerge(F, a, [1, 2, 3])),
- {'EXIT', _} = (catch lists:rmerge(F, [1, 2, 3], b)),
-
- ok.
-
-
-funsort_1(Config) when is_list(Config) ->
- ok = funsort_check(1, [], []),
- ok = funsort_check(1, [{a,b}], [{a,b}]),
- ok = funsort_check(1, [{a,b},{a,b}], [{a,b},{a,b}]),
- ok = funsort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]),
- ok = funsort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]),
- ok = funsort_check(1,
- [{1,e},{3,f},{2,y},{0,z},{x,14}],
- [{0,z},{1,e},{2,y},{3,f},{x,14}]),
- F = funsort_fun(1),
-
- [{b,1},{c,1}] = lists:sort(F, [{c,1},{b,1}]),
- [{a,0},{b,2},{c,3},{d,4}] =
- lists:sort(F, [{d,4},{c,3},{b,2},{a,0}]),
- [{a,0},{b,1},{b,2},{c,1}] =
- lists:sort(F, [{c,1},{b,1},{b,2},{a,0}]),
- [{a,0},{b,1},{b,2},{c,1},{d,4}] =
- lists:sort(F, [{c,1},{b,1},{b,2},{a,0},{d,4}]),
-
- SFun = fun(L) -> fun(X) -> funsort_check(1, X, L) end end,
- L1 = [{1,a},{1,a},{2,b},{2,b},{3,c},{4,d},{5,e},{6,f}],
- lists:foreach(SFun(L1), perms(L1)),
-
- ok.
-
-%% sort/2 should be stable.
-funsort_stable(Config) when is_list(Config) ->
- ok = funsort_check(1, [{1,b},{1,c}], [{1,b},{1,c}]),
- ok = funsort_check(1, [{1,c},{1,b}], [{1,c},{1,b}]),
- ok = funsort_check(1,
- [{1,c},{1,b},{2,x},{3,p},{2,a}],
- [{1,c},{1,b},{2,x},{2,a},{3,p}]),
- ok.
-
-%% sort/2 should exit when given bad arguments.
-funsort_error(Config) when is_list(Config) ->
- {'EXIT', _} = (catch lists:sort(1, [{1,b} , {1,c}])),
- {'EXIT', _} = (catch lists:sort(fun(X,Y) -> X =< Y end,
- [{1,b} | {1,c}])),
- ok.
-
-%% sort/2 on big randomized lists.
-funsort_rand(Config) when is_list(Config) ->
- ok = funsort_check3(1, biglist(10)),
- ok = funsort_check3(1, biglist(100)),
- ok = funsort_check3(1, biglist(1000)),
- ok = funsort_check3(1, biglist(10000)),
- ok.
-
-%% Do a keysort
-funsort(I, L) ->
- lists:sort(funsort_fun(I), L).
-
-funsort_check3(I, Input) ->
- check_sorted(I, 3, Input, funsort(I, Input)).
-
-%%% Keysort a list, check that the returned list is what we expected,
-%%% and that it is actually sorted.
-funsort_check(I, Input, Expected) ->
- Expected = funsort(I, Input),
- check_sorted(I, Input, Expected).
-
-
-%% Merge two lists while removing duplicates using a fun.
-ufunmerge(Conf) when is_list(Conf) ->
-
- Singleton = id([a, b, c]),
- Two = [1,2],
- Six = [1,2,3,4,5,6],
- F = fun(X, Y) -> X =< Y end,
-
- %% 2-way unique merge
- [] = lists:umerge(F, [], []),
- Two = lists:umerge(F, Two, []),
- Two = lists:umerge(F, [], Two),
- Six = lists:umerge(F, [1,3,5], [2,4,6]),
- Six = lists:umerge(F, [2,4,6], [1,3,5]),
- Six = lists:umerge(F, [1,2,3], [4,5,6]),
- Six = lists:umerge(F, [4,5,6], [1,2,3]),
- Six = lists:umerge(F, [1,2,5],[3,4,6]),
- [1,2,3,5,7] = lists:umerge(F, [1,3,5,7], [2]),
- [1,2,3,4,5,7] = lists:umerge(F, [1,3,5,7], [2,4]),
- [1,2,3,4,5,6,7] = lists:umerge(F, [1,3,5,7], [2,4,6]),
- [1,2,3,5,7] = lists:umerge(F, [2], [1,3,5,7]),
- [1,2,3,4,5,7] = lists:umerge(F, [2,4], [1,3,5,7]),
- [1,2,3,4,5,6,7] = lists:umerge(F, [2,4,6], [1,3,5,7]),
-
- [1,2,3,5,7] = lists:umerge(F, [1,2,3,5,7], [2]),
- [1,2,3,4,5,7] = lists:umerge(F, [1,2,3,4,5,7], [2,4]),
- [1,2,3,4,5,6,7] = lists:umerge(F, [1,3,5,6,7], [2,4,6]),
- [1,2,3,5,7] = lists:umerge(F, [2], [1,2,3,5,7]),
- [1,2,3,4,5,7] = lists:umerge(F, [2,4], [1,2,3,4,5,7]),
- [1,2,3,4,5,6,7] = lists:umerge(F, [2,4,6], [1,2,3,4,5,6,7]),
-
- L1 = [{a,1},{a,3},{a,5},{a,7}],
- L2 = [{b,1},{b,3},{b,5},{b,7}],
- F2 = fun(X,Y) -> element(2,X) =< element(2,Y) end,
- L1 = lists:umerge(F2, L1, L2),
- [{b,2},{e,5},{c,11},{c,12},{c,21},{c,22}] =
- lists:umerge(F2, [{e,5},{c,11},{c,12}], [{b,2},{c,21},{c,22}]),
-
- true = erts_debug:same(Singleton, lists:umerge(F, Singleton, [])),
- true = erts_debug:same(Singleton, lists:umerge(F, [], Singleton)),
-
- {'EXIT', _} = (catch lists:umerge(F, a, b)),
- {'EXIT', _} = (catch lists:umerge(F, a, [])),
- {'EXIT', _} = (catch lists:umerge(F, [], b)),
- {'EXIT', _} = (catch lists:umerge(F, a, [1, 2, 3])),
- {'EXIT', _} = (catch lists:umerge(F, [1, 2, 3], b)),
-
- ok.
-
-%% Reverse merge two lists while removing duplicates using a fun.
-rufunmerge(Conf) when is_list(Conf) ->
- Singleton = id([a, b, c]),
- Two = [2,1],
- Six = [6,5,4,3,2,1],
- F = fun(X, Y) -> X =< Y end,
-
- %% 2-way reversed unique merge
- [] = lists:rumerge(F, [], []),
- Two = lists:rumerge(F, Two, []),
- Two = lists:rumerge(F, [], Two),
- Six = lists:rumerge(F, [5,3,1], [6,4,2]),
- Six = lists:rumerge(F, [6,4,2], [5,3,1]),
- Six = lists:rumerge(F, [3,2,1], [6,5,4]),
- Six = lists:rumerge(F, [6,5,4], [3,2,1]),
- Six = lists:rumerge(F, [4,3,2],[6,5,1]),
- [7,6,5,3,1] = lists:rumerge(F, [7,5,3,1], [6]),
- [7,6,5,4,3,1] = lists:rumerge(F, [7,5,3,1], [6,4]),
- [7,6,5,4,3,2,1] = lists:rumerge(F, [7,5,3,1], [6,4,2]),
- [7,5,3,2,1] = lists:rumerge(F, [2], [7,5,3,1]),
- [7,5,4,3,2,1] = lists:rumerge(F, [4,2], [7,5,3,1]),
- [7,6,5,4,3,2,1] = lists:rumerge(F, [6,4,2], [7,5,3,1]),
-
- [7,6,5,3,1] = lists:rumerge(F, [7,6,5,3,1], [6]),
- [7,6,5,4,3,1] = lists:rumerge(F, [7,6,5,4,3,1], [6,4]),
- [7,6,5,4,3,2,1] = lists:rumerge(F, [7,6,5,4,3,2,1], [6,4,2]),
- [7,5,3,2,1] = lists:rumerge(F, [2], [7,5,3,2,1]),
- [7,5,4,3,2,1] = lists:rumerge(F, [4,2], [7,5,4,3,2,1]),
- [7,6,5,4,3,2,1] = lists:rumerge(F, [6,4,2], [7,6,5,4,3,2,1]),
-
- F2 = fun(X,Y) -> element(1,X) =< element(1,Y) end,
- L1 = [{1,a},{1,b},{1,a}],
- L2 = [{1,a},{1,b},{1,a}],
- true = lists:umerge(F2, L1, L2) ==
- lists:reverse(lists:rumerge(F, lists:reverse(L2), lists:reverse(L1))),
-
- L3 = [{c,11},{c,12},{e,5}],
- L4 = [{b,2},{c,21},{c,22}],
- true =
- lists:umerge(F2, L3, L4) ==
- lists:reverse(lists:rumerge(F2,lists:reverse(L3), lists:reverse(L4))),
-
- true = erts_debug:same(Singleton, lists:rumerge(F, Singleton, [])),
- true = erts_debug:same(Singleton, lists:rumerge(F, [], Singleton)),
-
- {'EXIT', _} = (catch lists:rumerge(F, a, b)),
- {'EXIT', _} = (catch lists:rumerge(F, a, [])),
- {'EXIT', _} = (catch lists:rumerge(F, [], b)),
- {'EXIT', _} = (catch lists:rumerge(F, a, [1, 2, 3])),
- {'EXIT', _} = (catch lists:rumerge(F, [1, 2, 3], b)),
-
- ok.
-
-ufunsort_1(Config) when is_list(Config) ->
- ok = ufunsort_check(1, [], []),
- ok = ufunsort_check(1, [{a,b}], [{a,b}]),
- ok = ufunsort_check(1, [{a,b},{a,b}], [{a,b}]),
- ok = ufunsort_check(1, [{a,b},{b,c}], [{a,b},{b,c}]),
- ok = ufunsort_check(1, [{b,c},{a,b}], [{a,b},{b,c}]),
- ok = ufunsort_check(1,
- [{1,e},{3,f},{2,y},{0,z},{x,14}],
- [{0,z},{1,e},{2,y},{3,f},{x,14}]),
- ok = ufunsort_check(1,
- [{1,a},{2,b},{3,c},{2,b},{1,a},{2,b},{3,c},
- {2,b},{1,a}],
- [{1,a},{2,b},{3,c}]),
- ok = ufunsort_check(1,
- [{1,a},{1,a},{1,b},{1,b},{1,a},{2,a}],
- [{1,a},{2,a}]),
-
- F = funsort_fun(1),
- L1 = [{1,a},{1,b},{1,a}],
- L2 = [{1,a},{1,b},{1,a}],
- ok = ufunsort_check(1, lists:keymerge(1, L1, L2),
- lists:umerge(F, lists:usort(F, L1),
- lists:usort(F, L2))),
- L3 = [{1,a},{1,b},{1,a},{2,a}],
- ok = ufunsort_check(1, lists:keymerge(1, L3, L2),
- lists:umerge(F, lists:usort(F, L3),
- lists:usort(F, L2))),
- L4 = [{1,b},{1,a}],
- ok = ufunsort_check(1, lists:keymerge(1, L1, L4),
- lists:umerge(F, lists:usort(F, L1),
- lists:usort(F, L4))),
- L5 = [{1,a},{1,b},{1,a},{2,a}],
- ok = ufunsort_check(1, lists:keymerge(1, L5, []),
- lists:umerge(F, lists:usort(F, L5), [])),
- L6 = [{3,a}],
- ok = ufunsort_check(1, lists:keymerge(1, L5, L6),
- lists:umerge(F, lists:usort(F, L5),
- lists:usort(F, L6))),
-
- [{b,1},{c,1}] = lists:usort(F, [{c,1},{c,1},{b,1}]),
- [{a,0},{b,2},{c,3},{d,4}] =
- lists:usort(F, [{d,4},{c,3},{b,2},{b,2},{a,0}]),
- [{a,0},{b,1},{c,1}] =
- lists:usort(F, [{c,1},{b,1},{b,1},{b,2},{b,2},{a,0}]),
- [{a,0},{b,1},{c,1},{d,4}] =
- lists:usort(F, [{c,1},{b,1},{b,2},{a,0},{a,0},{d,4},{d,4}]),
-
- SFun = fun(L) -> fun(X) -> ufunsort_check(1, X, L) end end,
- PL = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f}],
- Ps = perms([{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{2,b},{1,a}]),
- lists:foreach(SFun(PL), Ps),
-
- ok.
-
-%% usort/2 should be stable.
-ufunsort_stable(Config) when is_list(Config) ->
- ok = ufunsort_check(1, [{1,b},{1,c}], [{1,b}]),
- ok = ufunsort_check(1, [{1,c},{1,b}], [{1,c}]),
- ok = ufunsort_check(1,
- [{1,c},{1,b},{2,x},{3,p},{2,a}],
- [{1,c},{2,x},{3,p}]),
-
- ok = ufunsort_check_stability(bigfunlist(10)),
- ok = ufunsort_check_stability(bigfunlist(100)),
- ok = ufunsort_check_stability(bigfunlist(1000)),
- case erlang:system_info(modified_timing_level) of
- undefined -> ok = ufunsort_check_stability(bigfunlist(10000));
- _ -> ok
- end,
- ok.
-
-%% usort/2 should exit when given bad arguments.
-ufunsort_error(Config) when is_list(Config) ->
- {'EXIT', _} = (catch lists:usort(1, [{1,b} , {1,c}])),
- {'EXIT', _} = (catch lists:usort(fun(X,Y) -> X =< Y end,
- [{1,b} | {1,c}])),
- ok.
-
-%% usort/2 on big randomized lists.
-ufunsort_rand(Config) when is_list(Config) ->
- ok = ufunsort_check3(1, biglist(10)),
- ok = ufunsort_check3(1, biglist(100)),
- ok = ufunsort_check3(1, biglist(1000)),
- ok = ufunsort_check3(1, biglist(10000)),
-
- ok = gen_ufunsort_check(1, ubiglist(100)),
- ok = gen_ufunsort_check(1, ubiglist(1000)),
- ok = gen_ufunsort_check(1, ubiglist(10000)),
- ok.
-
-%% Check that usort/2 is stable and correct relative sort/2.
-gen_ufunsort_check(I, Input) ->
- U = ufunsort(I, Input),
- S = funsort(I, Input),
- case U == no_dups_keys(S, I) of
- true ->
- ok;
- false ->
- io:format("~w~n", [Input]),
- erlang:error(gen_ufunsort_check)
- end.
-
-%% Used for checking that the first copy is kept.
-ufunsort_check_stability(L) ->
- I = 1,
- U = ufunsort(I, L),
- S = no_dups(funsort(I, L)),
- check_stab(L, U, S, "usort/2", "sort/2").
-
-ufunsort_check3(I, Input) ->
- ucheck_sorted(I, 3, Input, ufunsort(I, Input)).
-
-%%% Keysort a list, check that the returned list is what we expected,
-%%% and that it is actually sorted.
-ufunsort_check(I, Input, Expected) ->
- Expected = ufunsort(I, Input),
- ucheck_sorted(I, Input, Expected).
-
-%% Do a keysort
-ufunsort(I, L) ->
- lists:usort(funsort_fun(I), L).
-
-funsort_fun(I) ->
- fun(A, B) when tuple_size(A) >= I, tuple_size(B) >= I ->
- element(I, A) =< element(I, B)
- end.
-
-check_stab(L, U, S, US, SS) ->
- UP = explicit_pid(U),
- SP = explicit_pid(S),
- case UP == SP of
- true ->
- ok;
- false ->
- io:format("In: ~w~n", [explicit_pid(L)]),
- io:format("~s: ~w~n", [US, UP]),
- io:format("~s: ~w~n", [SS, SP]),
- erlang:error(unstable)
- end.
-
test_stable_ukeysort(StableKeys, Ks) ->
StableList_1 = [{K} || K <- StableKeys],
StableUList_1 = ukeylist(1, StableList_1),
@@ -1908,50 +1411,6 @@ urandom_tuple(N, I) ->
R2 = randint(I),
{R1, R2}.
-%%%------------------------------------------------------------
-%%% Generate lists of given length, containing 2-tuples with random
-%%% integer elements in the range 0..10 as elements 1. All tuples have
-%%% the same function as element 2, but every function is created in a
-%%% unique process. ==/2 will return 'true' for any pair of functions,
-%%% but erlang:fun_info(Fun, pid) can be used for distinguishing
-%%% functions created in different processes. The pid acts like a
-%%% sequence number.
-
-bigfunlist(N) ->
- rand:seed(exsplus),
- bigfunlist_1(N).
-
-bigfunlist_1(N) when N < 30000 -> % Now (R8) max 32000 different pids.
- case catch bigfunlist(N, 0, []) of
- {'EXIT', _} ->
- bigfunlist_1(N);
- Reply ->
- Reply
- end.
-
-bigfunlist(0, _P, L) ->
- lists:reverse(L);
-bigfunlist(N, P, L) ->
- {E, NP} = random_funtuple(P, 11),
- bigfunlist(N-1, NP, [E | L]).
-
-random_funtuple(P, N) ->
- R = randint(N),
- F = make_fun(),
- NP = fun_pid(F),
- true = NP > P,
- {{R, F}, NP}.
-
-make_fun() ->
- Pid = spawn(?MODULE, make_fun, [self()]),
- receive {Pid, Fun} -> Fun end.
-
-make_fun(Pid) ->
- Pid ! {self(), fun (X) -> {X, Pid} end}.
-
-fun_pid(Fun) ->
- erlang:fun_info(Fun, pid).
-
random_tuple(N, Seq) ->
R1 = randint(N),
R2 = randint(N),
@@ -1960,19 +1419,6 @@ random_tuple(N, Seq) ->
randint(N) ->
trunc(rand:uniform() * N).
-%% The first "duplicate" is kept.
-no_dups([]) ->
- [];
-no_dups([H | T]) ->
- no_dups(H, T, []).
-
-no_dups(H, [H1 | T], L) when H == H1 ->
- no_dups(H, T, L);
-no_dups(H, [H1 | T], L) ->
- no_dups(H1, T, [H | L]);
-no_dups(H, [], L) ->
- lists:reverse([H | L]).
-
%% The first "duplicate" is kept.
no_dups_keys([], _I) ->
[];
@@ -1994,7 +1440,7 @@ perms(L) ->
%%%------------------------------------------------------------
%%% Test the sort routines with randomly generated lists.
--record(state, {sort = 0, usort = 0, stable = 0}).
+-record(state, {sort = 0, usort = 0}).
%% Run it interactively. 'stop' or 'info' recognized commands.
sort_loop() ->
@@ -2037,289 +1483,19 @@ sloop(N, S) ->
BL = biglist(Len, []),
ok = check(BL),
ok = keysort_check3(1, BL),
- ok = funsort_check3(1, BL),
S#state{sort = S#state.sort + 1};
1 ->
BL = ubiglist(Len, []),
ok = ucheck(BL),
ok = gen_ukeysort_check(1, BL),
- ok = gen_ufunsort_check(1, BL),
- S#state{usort = S#state.usort + 1};
- 2 ->
- BL = bigfunlist(Len),
- %% ok = check_stability(BL),
- ok = ucheck_stability(BL),
- ok = ukeysort_check_stability(BL),
- ok = ufunsort_check_stability(BL),
- S#state{stable = S#state.stable + 1}
+ S#state{usort = S#state.usort + 1}
end,
sloop(N, NS)
end.
display_state(S) ->
io:format("sort: ~p~n", [S#state.sort]),
- io:format("usort: ~p~n", [S#state.usort]),
- io:format("stable: ~p~n", [S#state.stable]).
-
-%% This version of sort/1 is really stable; the order of equal
-%% elements is kept. It is used for checking the current
-%% implementation of usort/1 etc.
-
-lsort([X, Y | L] = L0) when X =< Y ->
- case L of
- [] ->
- L0;
- [Z] when Y =< Z ->
- L0;
- [Z] when X =< Z ->
- [X, Z, Y];
- [Z] ->
- [Z, X, Y];
- _ ->
- split_1(X, Y, L, [], [])
- end;
-lsort([X, Y | L]) ->
- case L of
- [] ->
- [Y, X];
- [Z] when X =< Z ->
- [Y, X | L];
- [Z] when Y =< Z ->
- [Y, Z, X];
- [Z] ->
- [Z, Y, X];
- _ ->
- split_2(X, Y, L, [], [])
- end;
-lsort([_] = L) ->
- L;
-lsort([] = L) ->
- L.
-
-split_1(X, Y, [Z | L], R, Rs) when Z >= Y ->
- split_1(Y, Z, L, [X | R], Rs);
-split_1(X, Y, [Z | L], R, Rs) when Z >= X ->
- split_1(Z, Y, L, [X | R], Rs);
-split_1(X, Y, [Z | L], [], Rs) ->
- split_1(X, Y, L, [Z], Rs);
-split_1(X, Y, [Z | L], R, Rs) ->
- split_1_1(X, Y, L, R, Rs, Z);
-split_1(X, Y, [], R, Rs) ->
- rmergel([[Y, X | R] | Rs], [], asc).
-
-split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y ->
- split_1_1(Y, Z, L, [X | R], Rs, S);
-split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X ->
- split_1_1(Z, Y, L, [X | R], Rs, S);
-split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z ->
- split_1(S, Z, L, [], [[Y, X | R] | Rs]);
-split_1_1(X, Y, [Z | L], R, Rs, S) ->
- split_1(Z, S, L, [], [[Y, X | R] | Rs]);
-split_1_1(X, Y, [], R, Rs, S) ->
- rmergel([[S], [Y, X | R] | Rs], [], asc).
-
-split_2(X, Y, [Z | L], R, Rs) when Z < Y ->
- split_2(Y, Z, L, [X | R], Rs);
-split_2(X, Y, [Z | L], R, Rs) when Z < X ->
- split_2(Z, Y, L, [X | R], Rs);
-split_2(X, Y, [Z | L], [], Rs) ->
- split_2(X, Y, L, [Z], Rs);
-split_2(X, Y, [Z | L], R, Rs) ->
- split_2_1(X, Y, L, R, Rs, Z);
-split_2(X, Y, [], R, Rs) ->
- mergel([[Y, X | R] | Rs], [], desc).
-
-split_2_1(X, Y, [Z | L], R, Rs, S) when Z < Y ->
- split_2_1(Y, Z, L, [X | R], Rs, S);
-split_2_1(X, Y, [Z | L], R, Rs, S) when Z < X ->
- split_2_1(Z, Y, L, [X | R], Rs, S);
-split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z ->
- split_2(S, Z, L, [], [[Y, X | R] | Rs]);
-split_2_1(X, Y, [Z | L], R, Rs, S) ->
- split_2(Z, S, L, [], [[Y, X | R] | Rs]);
-split_2_1(X, Y, [], R, Rs, S) ->
- mergel([[S], [Y, X | R] | Rs], [], desc).
-
-mergel([[] | L], Acc, O) ->
- mergel(L, Acc, O);
-mergel([T1, [H2 | T2] | L], Acc, asc) ->
- mergel(L, [merge2_1(T1, H2, T2, []) | Acc], asc);
-mergel([[H2 | T2], T1 | L], Acc, desc) ->
- mergel(L, [merge2_1(T1, H2, T2, []) | Acc], desc);
-mergel([L], [], _O) ->
- L;
-mergel([L], Acc, O) ->
- rmergel([lists:reverse(L, []) | Acc], [], O);
-mergel([], [], _O) ->
- [];
-mergel([], Acc, O) ->
- rmergel(Acc, [], O);
-mergel([A, [] | L], Acc, O) ->
- mergel([A | L], Acc, O);
-mergel([A, B, [] | L], Acc, O) ->
- mergel([A, B | L], Acc, O).
-
-rmergel([[H2 | T2], T1 | L], Acc, asc) ->
- rmergel(L, [rmerge2_1(T1, H2, T2, []) | Acc], asc);
-rmergel([T1, [H2 | T2] | L], Acc, desc) ->
- rmergel(L, [rmerge2_1(T1, H2, T2, []) | Acc], desc);
-rmergel([L], Acc, O) ->
- mergel([lists:reverse(L, []) | Acc], [], O);
-rmergel([], Acc, O) ->
- mergel(Acc, [], O).
-
-merge2_1([H1 | T1], H2, T2, M) when H1 =< H2 ->
- merge2_1(T1, H2, T2, [H1 | M]);
-merge2_1([H1 | T1], H2, T2, M) ->
- merge2_2(T1, H1, T2, [H2 | M]);
-merge2_1([], H2, T2, M) ->
- lists:reverse(T2, [H2 | M]).
-
-merge2_2(T1, H1, [H2 | T2], M) when H1 =< H2 ->
- merge2_1(T1, H2, T2, [H1 | M]);
-merge2_2(T1, H1, [H2 | T2], M) ->
- merge2_2(T1, H1, T2, [H2 | M]);
-merge2_2(T1, H1, [], M) ->
- lists:reverse(T1, [H1 | M]).
-
-rmerge2_1([H1 | T1], H2, T2, M) when H1 =< H2 ->
- rmerge2_2(T1, H1, T2, [H2 | M]);
-rmerge2_1([H1 | T1], H2, T2, M) ->
- rmerge2_1(T1, H2, T2, [H1 | M]);
-rmerge2_1([], H2, T2, M) ->
- lists:reverse(T2, [H2 | M]).
-
-rmerge2_2(T1, H1, [H2 | T2], M) when H1 =< H2 ->
- rmerge2_2(T1, H1, T2, [H2 | M]);
-rmerge2_2(T1, H1, [H2 | T2], M) ->
- rmerge2_1(T1, H2, T2, [H1 | M]);
-rmerge2_2(T1, H1, [], M) ->
- lists:reverse(T1, [H1 | M]).
-
-
-
-%% This version of keysort/2 is really stable; the order of equal
-%% elements is kept. It is used for checking the current
-%% implementation of ukeysort/2 etc.
-
-lkeysort(Index, L) when is_integer(Index), Index > 0 ->
- case L of
- [] -> L;
- [_] -> L;
- [X, Y | T] ->
- EX = element(Index, X),
- EY = element(Index, Y),
- if
- EX =< EY ->
- keysplit_1(Index, X, EX, Y, EY, T, [], []);
- true ->
- keysplit_2(Index, Y, EY, T, [X])
- end
- end.
-
-keysplit_1(I, X, EX, Y, EY, [Z | L], R, Rs) ->
- EZ = element(I, Z),
- if
- EY =< EZ ->
- keysplit_1(I, Y, EY, Z, EZ, L, [X | R], Rs);
- EX =< EZ ->
- keysplit_1(I, Z, EZ, Y, EY, L, [X | R], Rs);
- true, R == [] ->
- keysplit_1(I, X, EX, Y, EY, L, [Z], Rs);
- true ->
- keysplit_1_1(I, X, EX, Y, EY, L, R, Rs, Z, EZ)
- end;
-keysplit_1(I, X, _EX, Y, _EY, [], R, Rs) ->
- rkeymergel(I, [[Y, X | R] | Rs], []).
-
-%% One out-of-order element, S.
-keysplit_1_1(I, X, EX, Y, EY, [Z | L], R, Rs, S, ES) ->
- EZ = element(I, Z),
- if
- EY =< EZ ->
- keysplit_1_1(I, Y, EY, Z, EZ, L, [X | R], Rs, S, ES);
- EX =< EZ ->
- keysplit_1_1(I, Z, EZ, Y, EY, L, [X | R], Rs, S, ES);
- ES =< EZ ->
- keysplit_1(I, S, ES, Z, EZ, L, [], [[Y, X | R] | Rs]);
- true ->
- keysplit_1(I, Z, EZ, S, ES, L, [], [[Y, X | R] | Rs])
- end;
-keysplit_1_1(I, X, _EX, Y, _EY, [], R, Rs, S, _ES) ->
- rkeymergel(I, [[S], [Y, X | R] | Rs], []).
-
-%% Descending.
-keysplit_2(I, Y, EY, [Z | L], R) ->
- EZ = element(I, Z),
- if
- EY =< EZ ->
- keysplit_1(I, Y, EY, Z, EZ, L, [], [lists:reverse(R, [])]);
- true ->
- keysplit_2(I, Z, EZ, L, [Y | R])
- end;
-keysplit_2(_I, Y, _EY, [], R) ->
- [Y | R].
-
-keymergel(I, [T1, [H2 | T2] | L], Acc) ->
- keymergel(I, L, [keymerge2_1(I, T1, element(I, H2), H2, T2, []) | Acc]);
-keymergel(_I, [L], []) ->
- L;
-keymergel(I, [L], Acc) ->
- rkeymergel(I, [lists:reverse(L, []) | Acc], []);
-keymergel(I, [], Acc) ->
- rkeymergel(I, Acc, []).
-
-rkeymergel(I, [[H2 | T2], T1 | L], Acc) ->
- rkeymergel(I, L, [rkeymerge2_1(I, T1, element(I, H2), H2, T2, []) | Acc]);
-rkeymergel(I, [L], Acc) ->
- keymergel(I, [lists:reverse(L, []) | Acc], []);
-rkeymergel(I, [], Acc) ->
- keymergel(I, Acc, []).
-
-keymerge2_1(I, [H1 | T1], E2, H2, T2, M) ->
- E1 = element(I, H1),
- if
- E1 =< E2 ->
- keymerge2_1(I, T1, E2, H2, T2, [H1 | M]);
- true ->
- keymerge2_2(I, T1, E1, H1, T2, [H2 | M])
- end;
-keymerge2_1(_I, [], _E2, H2, T2, M) ->
- lists:reverse(T2, [H2 | M]).
-
-keymerge2_2(I, T1, E1, H1, [H2 | T2], M) ->
- E2 = element(I, H2),
- if
- E1 =< E2 ->
- keymerge2_1(I, T1, E2, H2, T2, [H1 | M]);
- true ->
- keymerge2_2(I, T1, E1, H1, T2, [H2 | M])
- end;
-keymerge2_2(_I, T1, _E1, H1, [], M) ->
- lists:reverse(T1, [H1 | M]).
-
-rkeymerge2_1(I, [H1 | T1], E2, H2, T2, M) ->
- E1 = element(I, H1),
- if
- E1 =< E2 ->
- rkeymerge2_2(I, T1, E1, T2, [H2 | M], H1);
- true ->
- rkeymerge2_1(I, T1, E2, H2, T2, [H1 | M])
- end;
-rkeymerge2_1(_I, [], _E2, H2, T2, M) ->
- lists:reverse(T2, [H2 | M]).
-
-rkeymerge2_2(I, T1, E1, [H2 | T2], M, H1) ->
- E2 = element(I, H2),
- if
- E1 =< E2 ->
- rkeymerge2_2(I, T1, E1, T2, [H2 | M], H1);
- true ->
- rkeymerge2_1(I, T1, E2, H2, T2, [H1 | M])
- end;
-rkeymerge2_2(_I, T1, _E1, [], M, H1) ->
- lists:reverse(T1, [H1 | M]).
-
+ io:format("usort: ~p~n", [S#state.usort]).
%%%------------------------------------------------------------
@@ -2543,7 +1719,6 @@ sublist_3_e(Config) when is_list(Config) ->
-define(flatten_error1(X), {'EXIT', _} = (catch lists:flatten(X))).
--define(flatten_error2(X,Y), {'EXIT', _} = (catch lists:flatten(X,Y))).
%% Test lists:flatten/1,2 and lists:flatlength/1.
flatten_1(Config) when is_list(Config) ->
--
2.35.3
