aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--README.md26
-rw-r--r--erts/emulator/beam/erl_db_hash.c34
-rw-r--r--erts/emulator/beam/erl_db_hash.h2
-rw-r--r--erts/emulator/beam/erl_nif.c25
-rw-r--r--erts/emulator/beam/external.c19
-rw-r--r--erts/emulator/sys/common/erl_mmap.c8
-rw-r--r--erts/emulator/sys/common/erl_mmap.h12
-rw-r--r--erts/emulator/test/trace_port_SUITE.erl22
-rw-r--r--lib/common_test/src/ct_master_logs.erl2
-rw-r--r--lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl7
-rw-r--r--lib/hipe/cerl/cerl_pmatch.erl28
-rw-r--r--lib/kernel/test/gen_udp_SUITE.erl2
-rw-r--r--lib/kernel/test/loose_node.erl11
-rw-r--r--lib/stdlib/test/ets_SUITE.erl24
-rw-r--r--lib/stdlib/test/slave_SUITE.erl1
-rw-r--r--lib/tools/emacs/erlang-test.el57
-rw-r--r--lib/tools/emacs/erlang.el160
-rw-r--r--system/doc/top/Makefile5
-rw-r--r--system/doc/top/src/erl_html_tools.erl28
-rw-r--r--system/doc/top/templates/index.html.src4
20 files changed, 271 insertions, 206 deletions
diff --git a/README.md b/README.md
index 9986d6bc18..127ac9cad7 100644
--- a/README.md
+++ b/README.md
@@ -36,29 +36,11 @@ Here are the [instructions for submitting patches] [2].
In short:
-* Go to the JIRA issue tracker at [bugs.erlang.org] [7] to see reported issues which you can contribute to. Search for issues with the status *Contribution Needed*.
+* Submit your patch by opening a new Pull Request.
-* We prefer to receive proposed updates via email on the
- [`erlang-patches`] [3] mailing list or through a pull request.
-
-* Pull requests will be handled once everyday and there will be
- essential testing before we will take a decision on the outcome
- of the request. If the essential testings fails, the pull request
- will be closed and you will have to fix the problem and submit another
- pull request when this is done.
-
-* We merge all proposed updates to the `pu` (*proposed updates*) branch,
- typically within one working day.
-
-* At least once a day, the contents of the `pu` branch will be built on
- several platforms (Linux, Solaris, Mac OS X, Windows, and so on) and
- automatic test suites will be run. We will email you if any problems are
- found.
-
-* If a proposed change builds and passes the tests, it will be reviewed
- by one or more members of the Erlang/OTP team at Ericsson. The reviewer
- may suggest improvements that are needed before the change can be accepted
- and merged.
+* Go to the JIRA issue tracker at [bugs.erlang.org] [7] to
+ see reported issues which you can contribute to.
+ Search for issues with the status *Contribution Needed*.
Bug Reports
diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c
index 074ac6d64e..74979f984a 100644
--- a/erts/emulator/beam/erl_db_hash.c
+++ b/erts/emulator/beam/erl_db_hash.c
@@ -95,8 +95,7 @@
/*
* The following symbols can be manipulated to "tune" the linear hash array
*/
-#define GROW_LIMIT(NACTIVE) ((NACTIVE)*2)
-#define SHRINK_LIMIT(NACTIVE) ((NACTIVE) / 2)
+#define CHAIN_LEN 6 /* Medium bucket chain len */
/* Number of slots per segment */
#define SEGSZ_EXP 8
@@ -464,7 +463,7 @@ db_finalize_dbterm_hash(int cret, DbUpdateHandle* handle);
static ERTS_INLINE void try_shrink(DbTableHash* tb)
{
int nactive = NACTIVE(tb);
- if (nactive > SEGSZ && NITEMS(tb) < SHRINK_LIMIT(nactive)
+ if (nactive > SEGSZ && NITEMS(tb) < (nactive * CHAIN_LEN)
&& !IS_FIXED(tb)) {
shrink(tb, nactive);
}
@@ -671,8 +670,8 @@ int db_create_hash(Process *p, DbTable *tbl)
tb->nsegs = NSEG_1;
tb->nslots = SEGSZ;
-#ifdef ERTS_SMP
erts_smp_atomic_init_nob(&tb->is_resizing, 0);
+#ifdef ERTS_SMP
if (tb->common.type & DB_FINE_LOCKED) {
erts_smp_rwmtx_opt_t rwmtx_opt = ERTS_SMP_RWMTX_OPT_DEFAULT_INITER;
int i;
@@ -863,7 +862,7 @@ Lnew:
WUNLOCK_HASH(lck);
{
int nactive = NACTIVE(tb);
- if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) {
+ if (nitems > nactive * (CHAIN_LEN+1) && !IS_FIXED(tb)) {
grow(tb, nactive);
}
}
@@ -2251,12 +2250,12 @@ static int db_free_table_continue_hash(DbTable *tbl)
done /= 2;
while(tb->nslots != 0) {
- done += 1 + SEGSZ/64 + free_seg(tb, 1);
+ free_seg(tb, 1);
/*
* If we have done enough work, get out here.
*/
- if (done >= DELETE_RECORD_LIMIT) {
+ if (++done >= (DELETE_RECORD_LIMIT / CHAIN_LEN / SEGSZ)) {
return 0; /* Not done */
}
}
@@ -2605,22 +2604,23 @@ static Eterm build_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2,
static ERTS_INLINE int
begin_resizing(DbTableHash* tb)
{
-#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
- return !erts_atomic_xchg_acqb(&tb->is_resizing, 1);
- else
- ERTS_LC_ASSERT(erts_lc_rwmtx_is_rwlocked(&tb->common.rwlock));
-#endif
- return 1;
+ return !erts_smp_atomic_xchg_acqb(&tb->is_resizing, 1);
+ else {
+ if (erts_smp_atomic_read_nob(&tb->is_resizing))
+ return 0;
+ erts_smp_atomic_set_nob(&tb->is_resizing, 1);
+ return 1;
+ }
}
static ERTS_INLINE void
done_resizing(DbTableHash* tb)
{
-#ifdef ERTS_SMP
if (DB_USING_FINE_LOCKING(tb))
- erts_atomic_set_relb(&tb->is_resizing, 0);
-#endif
+ erts_smp_atomic_set_relb(&tb->is_resizing, 0);
+ else
+ erts_smp_atomic_set_nob(&tb->is_resizing, 0);
}
/* Grow table with one new bucket.
@@ -2871,7 +2871,7 @@ db_lookup_dbterm_hash(Process *p, DbTable *tbl, Eterm key, Eterm obj,
int nitems = erts_smp_atomic_inc_read_nob(&tb->common.nitems);
int nactive = NACTIVE(tb);
- if (nitems > GROW_LIMIT(nactive) && !IS_FIXED(tb)) {
+ if (nitems > nactive * (CHAIN_LEN + 1) && !IS_FIXED(tb)) {
grow(tb, nactive);
}
}
diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h
index 081ff8fafc..e654363cd5 100644
--- a/erts/emulator/beam/erl_db_hash.h
+++ b/erts/emulator/beam/erl_db_hash.h
@@ -60,8 +60,8 @@ typedef struct db_table_hash {
/* List of slots where elements have been deleted while table was fixed */
erts_smp_atomic_t fixdel; /* (FixedDeletion*) */
erts_smp_atomic_t nactive; /* Number of "active" slots */
-#ifdef ERTS_SMP
erts_smp_atomic_t is_resizing; /* grow/shrink in progress */
+#ifdef ERTS_SMP
DbTableHashFineLocks* locks;
#endif
#ifdef VALGRIND
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 039f97ef43..23931f0e54 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -769,32 +769,25 @@ enif_port_command(ErlNifEnv *env, const ErlNifPort* to_port,
if (scheduler > 0)
prt = erts_port_lookup(to_port->port_id, iflags);
-#ifdef ERTS_DIRTY_SCHEDULERS
- else if (scheduler < 0) {
+ else {
+#ifdef ERTS_SMP
if (ERTS_PROC_IS_EXITING(c_p))
return 0;
prt = erts_thr_port_lookup(to_port->port_id, iflags);
- }
+#else
+ erts_exit(ERTS_ABORT_EXIT,
+ "enif_port_command: called from non-scheduler "
+ "thread on non-SMP VM");
#endif
- else {
- erts_exit(ERTS_ABORT_EXIT, "enif_port_command: "
- "called from non-scheduler thread");
}
if (!prt)
res = 0;
- else {
-
- if (IS_TRACED_FL(prt, F_TRACE_RECEIVE))
- trace_port_receive(prt, c_p->common.id, am_command, msg);
-
- res = erts_port_output_async(prt, c_p->common.id, msg);
- }
+ else
+ res = erts_port_output_async(prt, c_p->common.id, msg);
-#ifdef ERTS_DIRTY_SCHEDULERS
- if (scheduler < 0)
+ if (scheduler <= 0)
erts_port_dec_refc(prt);
-#endif
return res;
}
diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c
index 3c002d43a7..beed847578 100644
--- a/erts/emulator/beam/external.c
+++ b/erts/emulator/beam/external.c
@@ -2159,12 +2159,23 @@ enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags)
return ep;
}
+/*
+ * We use this atom as sysname in local pid/port/refs
+ * for the ETS compressed format (DFLAG_INTERNAL_TAGS).
+ *
+ * We used atom '' earlier but that turned out to cause problems
+ * for buggy erl_interface/ic usage of c-nodes with empty node names.
+ * A long atom reduces risk of nodes actually called this and the length
+ * does not matter anyway as it's encoded with atom index (ATOM_INTERNAL_REF2).
+ */
+#define INTERNAL_LOCAL_SYSNAME am_await_microstate_accounting_modifications
+
static byte*
enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags)
{
Uint on, os;
Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS))
- ? am_Empty : pid_node_name(pid));
+ ? INTERNAL_LOCAL_SYSNAME : pid_node_name(pid));
Uint32 creation = pid_creation(pid);
byte* tagp = ep++;
@@ -2268,7 +2279,7 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp)
static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation)
{
- if (sysname == am_Empty) /* && DFLAG_INTERNAL_TAGS */
+ if (sysname == INTERNAL_LOCAL_SYSNAME) /* && DFLAG_INTERNAL_TAGS */
return erts_this_node;
if (sysname == erts_this_node->sysname
@@ -2555,7 +2566,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case EXTERNAL_REF_DEF: {
Uint32 *ref_num;
Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj))
- ? am_Empty : ref_node_name(obj));
+ ? INTERNAL_LOCAL_SYSNAME : ref_node_name(obj));
Uint32 creation = ref_creation(obj);
byte* tagp = ep++;
@@ -2584,7 +2595,7 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep,
case PORT_DEF:
case EXTERNAL_PORT_DEF: {
Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj))
- ? am_Empty : port_node_name(obj));
+ ? INTERNAL_LOCAL_SYSNAME : port_node_name(obj));
Uint32 creation = port_creation(obj);
byte* tagp = ep++;
diff --git a/erts/emulator/sys/common/erl_mmap.c b/erts/emulator/sys/common/erl_mmap.c
index 53009a1481..7bbb406f29 100644
--- a/erts/emulator/sys/common/erl_mmap.c
+++ b/erts/emulator/sys/common/erl_mmap.c
@@ -1334,9 +1334,17 @@ os_mremap(void *ptr, UWord old_size, UWord new_size, int try_superalign)
#define ERTS_MMAP_RESERVE_PROT_EXEC (ERTS_MMAP_PROT_EXEC)
#define ERTS_MMAP_RESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
#define ERTS_MMAP_UNRESERVE_PROT (PROT_NONE)
+#if defined(__FreeBSD__)
+#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_FIXED)
+#else
#define ERTS_MMAP_UNRESERVE_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE|MAP_FIXED)
+#endif /* __FreeBSD__ */
#define ERTS_MMAP_VIRTUAL_PROT (PROT_NONE)
+#if defined(__FreeBSD__)
+#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS)
+#else
#define ERTS_MMAP_VIRTUAL_FLAGS (ERTS_MMAP_FLAGS|MAP_NORESERVE)
+#endif /* __FreeBSD__ */
static int
os_reserve_physical(char *ptr, UWord size, int exec)
diff --git a/erts/emulator/sys/common/erl_mmap.h b/erts/emulator/sys/common/erl_mmap.h
index 7ac61a82c1..fa51b663fa 100644
--- a/erts/emulator/sys/common/erl_mmap.h
+++ b/erts/emulator/sys/common/erl_mmap.h
@@ -38,7 +38,17 @@
# if HAVE_MREMAP
# define ERTS_HAVE_OS_MREMAP 1
# endif
-# if defined(MAP_FIXED) && defined(MAP_NORESERVE)
+/*
+ * MAP_NORESERVE is undefined in FreeBSD 10.x and later.
+ * This is to enable 64bit HiPE experimentally on FreeBSD.
+ * Note that on FreeBSD MAP_NORESERVE was "never implemented"
+ * even before 11.x (and the flag does not exist in /usr/src/sys/vm/mmap.c
+ * of 10.3-STABLE r301478 either), and HiPE was working on OTP 18.3.3,
+ * so mandating MAP_NORESERVE on FreeBSD might not be needed.
+ * See the following message on how MAP_NORESERVE was treated on FreeBSD:
+ * <http://lists.llvm.org/pipermail/cfe-commits/Week-of-Mon-20150202/122958.html>
+ */
+# if defined(MAP_FIXED) && (defined(MAP_NORESERVE) || defined(__FreeBSD__))
# define ERTS_HAVE_OS_PHYSICAL_MEMORY_RESERVATION 1
# endif
#endif
diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl
index a66563d15b..e4db368ea1 100644
--- a/erts/emulator/test/trace_port_SUITE.erl
+++ b/erts/emulator/test/trace_port_SUITE.erl
@@ -26,6 +26,7 @@
return_trace/1,
send/1,
receive_trace/1,
+ receive_trace_non_scheduler/1,
process_events/1,
schedule/1,
gc/1,
@@ -40,6 +41,7 @@ suite() ->
all() ->
[call_trace, return_trace, send, receive_trace,
+ receive_trace_non_scheduler,
process_events, schedule, gc,
default_tracer, tracer_port_crash].
@@ -184,6 +186,26 @@ receive_trace(Config) when is_list(Config) ->
expect({trace_ts,Receiver,'receive',Huge,ts}),
ok.
+%% Test sending receive traces to a port.
+receive_trace_non_scheduler(Config) when is_list(Config) ->
+ start_tracer(Config),
+ S = self(),
+ Receiver = spawn(
+ fun() ->
+ receive
+ go ->
+ Ref = S ! erlang:trace_delivered(all),
+ receive {trace_delivered, Ref, all} -> ok end
+ end
+ end),
+ trac(Receiver, true, ['receive']),
+ Receiver ! go,
+ Ref = receive R -> R end,
+ expect({trace,Receiver,'receive',go}),
+ expect({trace,Receiver,'receive',{trace_delivered, all, Ref}}),
+
+ ok.
+
%% Tests a few process events (like getting linked).
process_events(Config) when is_list(Config) ->
start_tracer(Config),
diff --git a/lib/common_test/src/ct_master_logs.erl b/lib/common_test/src/ct_master_logs.erl
index a2542171f8..52003f752d 100644
--- a/lib/common_test/src/ct_master_logs.erl
+++ b/lib/common_test/src/ct_master_logs.erl
@@ -560,7 +560,7 @@ get_format_args(Content) ->
make_dir(Dir) ->
case file:make_dir(Dir) of
- {error, exist} ->
+ {error, eexist} ->
ok;
Else ->
Else
diff --git a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
index 0b3f834732..20fdf1034b 100644
--- a/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
+++ b/lib/common_test/test/ct_config_SUITE_data/config/test/config_dynamic_SUITE.erl
@@ -73,7 +73,7 @@ test_get_known_variable(_)->
% localtime will be updated in 5 seconds, check that
test_localtime_update(_)->
Seconds = 5,
- LT1 = ct:get_config(localtime),
+ LT1 = ct:reload_config(localtime),
timer:sleep(Seconds*1000), % don't want scaling of this timer
LT2 = ct:reload_config(localtime),
case is_diff_ok(LT1, LT2, Seconds) of
@@ -137,6 +137,11 @@ my_dt_to_datetime([{date, D},{time, T}])->
is_diff_ok(DT1, DT2, Seconds)->
GS1 = calendar:datetime_to_gregorian_seconds(my_dt_to_datetime(DT1)),
GS2 = calendar:datetime_to_gregorian_seconds(my_dt_to_datetime(DT2)),
+ ct:log("Checking diff~n"
+ "DT1: ~p, gregorian seconds: ~p~n"
+ "DT2: ~p, gregorian seconds: ~p~n"
+ "Diff: ~p",
+ [DT1,GS1,DT2,GS2,GS2-GS1]),
if
GS2-GS1 > Seconds+Seconds/2;
GS2-GS1 < Seconds-Seconds/2->
diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl
index 594f2bf81c..ca27fff1dd 100644
--- a/lib/hipe/cerl/cerl_pmatch.erl
+++ b/lib/hipe/cerl/cerl_pmatch.erl
@@ -231,12 +231,9 @@ match_typegroup(T, V, Vs, Gs, Else, Env) ->
Else, Env),
typetest_clause(T, V, Body, Env).
-match_congroup({?binary_id, Segs}, Vs, Cs, _Else, Env) ->
- Ref = get_unique(),
- Guard = cerl:c_primop(cerl:c_atom(set_label), [cerl:c_int(Ref)]),
- NewElse = cerl:c_primop(cerl:c_atom(goto_label), [cerl:c_int(Ref)]),
- Body = match(Vs, Cs, NewElse, Env),
- cerl:c_clause([make_pat(?binary_id, Segs)], Guard, Body);
+match_congroup({?binary_id, Segs}, Vs, Cs, Else, Env) ->
+ Body = match(Vs, Cs, Else, Env),
+ cerl:c_clause([make_pat(?binary_id, Segs)], Body);
match_congroup({D, A}, Vs, Cs, Else, Env) ->
Vs1 = new_vars(A, Env),
@@ -415,6 +412,15 @@ make_let(Vs, A, B) ->
expr(E, Env) ->
case cerl:type(E) of
+ binary ->
+ Es = expr_list(cerl:binary_segments(E), Env),
+ cerl:update_c_binary(E, Es);
+ bitstr ->
+ V = expr(cerl:bitstr_val(E), Env),
+ Sz = expr(cerl:bitstr_size(E), Env),
+ Unit = expr(cerl:bitstr_unit(E), Env),
+ Type = expr(cerl:bitstr_type(E), Env),
+ cerl:update_c_bitstr(E, V, Sz, Unit, Type, cerl:bitstr_flags(E));
literal ->
E;
var ->
@@ -584,16 +590,6 @@ is_simple(E) ->
end.
-get_unique() ->
- case get(unique_label) of
- undefined ->
- put(unique_label, 1),
- 0;
- N ->
- put(unique_label, N+1),
- N
- end.
-
%% ---------------------------------------------------------------------
%% Abstract datatype: environment()
diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl
index 85dc6312ea..44539bf44c 100644
--- a/lib/kernel/test/gen_udp_SUITE.erl
+++ b/lib/kernel/test/gen_udp_SUITE.erl
@@ -572,7 +572,7 @@ connect(Config) when is_list(Config) ->
ok = gen_udp:close(S1),
ok = gen_udp:connect(S2, Addr, P1),
ok = gen_udp:send(S2, <<16#deadbeef:32>>),
- ok = case gen_udp:recv(S2, 0, 5) of
+ ok = case gen_udp:recv(S2, 0, 500) of
{error,econnrefused} -> ok;
{error,econnreset} -> ok;
Other -> Other
diff --git a/lib/kernel/test/loose_node.erl b/lib/kernel/test/loose_node.erl
index 93530c2735..cc3f9bbea0 100644
--- a/lib/kernel/test/loose_node.erl
+++ b/lib/kernel/test/loose_node.erl
@@ -57,9 +57,16 @@
%%
stop(Node) when is_atom(Node) ->
+ erlang:monitor_node(Node, true),
rpc:cast(Node, erlang, halt, []),
- io:format("Stopped loose node ~p~n", [Node]),
- ok.
+ receive
+ {nodedown, Node} ->
+ io:format("Stopped loose node ~p~n", [Node]),
+ ok
+ after 10000 ->
+ io:format("Failed to stop loose node: ~p~n", [Node]),
+ {error, node_not_stopped}
+ end.
start(Name, Args) ->
start(Name, Args, -1).
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 40764a943d..8c1c625676 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -215,7 +215,7 @@ memory_check_summary(_Config) ->
receive {get_failed_memchecks, FailedMemchecks} -> ok end,
io:format("Failed memchecks: ~p\n",[FailedMemchecks]),
NoFailedMemchecks = length(FailedMemchecks),
- if NoFailedMemchecks > 300 ->
+ if NoFailedMemchecks > 3 ->
ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]);
true ->
ok
@@ -604,9 +604,9 @@ memory(Config) when is_list(Config) ->
memory_do(Opts) ->
L = [T1,T2,T3,T4] = fill_sets_int(1000,Opts),
XR1 = case mem_mode(T1) of
- {normal,_} -> {13836,13560,13560,13566}; %{13836,13046,13046,13052}
- {compressed,4} -> {11041,10865,10865,10866}; %{11041,10251,10251,10252}
- {compressed,8} -> {10050,9774,9774,9774} % {10050,9260,9260,9260}
+ {normal,_} -> {13836,13046,13046,13052}; %{13862,13072,13072,13078};
+ {compressed,4} -> {11041,10251,10251,10252}; %{11067,10277,10277,10278};
+ {compressed,8} -> {10050,9260,9260,9260} %{10076,9286,9286,9286}
end,
XRes1 = adjust_xmem(L, XR1),
Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)},
@@ -620,9 +620,9 @@ memory_do(Opts) ->
end,
L),
XR2 = case mem_mode(T1) of
- {normal,_} -> {13826,13551,13542,13548}; %{13826,13037,13028,13034};
- {compressed,4} -> {11031,10856,10747,10748}; %{11031,10242,10233,10234};
- {compressed,8} -> {10040,9765,9756,9756} %{10040,9251,9242,9242}
+ {normal,_} -> {13826,13037,13028,13034}; %{13852,13063,13054,13060};
+ {compressed,4} -> {11031,10242,10233,10234}; %{11057,10268,10259,10260};
+ {compressed,8} -> {10040,9251,9242,9242} %10066,9277,9268,9268}
end,
XRes2 = adjust_xmem(L, XR2),
Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)},
@@ -636,9 +636,9 @@ memory_do(Opts) ->
end,
L),
XR3 = case mem_mode(T1) of
- {normal,_} -> {13816,13542,13524,13530}; %{13816,13028,13010,13016}
- {compressed,4} -> {11021,10747,10729,10730}; %{11021,10233,10215,10216}
- {compressed,8} -> {10030,9756,9738,9738} %{10030,9242,9224,9224}
+ {normal,_} -> {13816,13028,13010,13016}; %{13842,13054,13036,13042};
+ {compressed,4} -> {11021,10233,10215,10216}; %{11047,10259,10241,10242};
+ {compressed,8} -> {10030,9242,9224,9224} %{10056,9268,9250,9250}
end,
XRes3 = adjust_xmem(L, XR3),
Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)},
@@ -5350,12 +5350,12 @@ verify_table_load(T) ->
Stats = ets:info(T,stats),
{Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats,
ok = if
- AvgLen > 2 ->
+ AvgLen > 7 ->
io:format("Table overloaded: Stats=~p\n~p\n",
[Stats, ets:info(T)]),
false;
- Buckets>256, AvgLen < 0.5 ->
+ Buckets>256, AvgLen < 6 ->
io:format("Table underloaded: Stats=~p\n~p\n",
[Stats, ets:info(T)]),
false;
diff --git a/lib/stdlib/test/slave_SUITE.erl b/lib/stdlib/test/slave_SUITE.erl
index 25b706e81f..7525cf78de 100644
--- a/lib/stdlib/test/slave_SUITE.erl
+++ b/lib/stdlib/test/slave_SUITE.erl
@@ -71,6 +71,7 @@ t_start_link(Config) when is_list(Config) ->
rpc:cast(Slave1, erlang, halt, []),
rpc:cast(Slave2, erlang, halt, []),
+ ct:sleep(250),
is_dead(Slave1),
is_dead(Slave2),
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
index a5aab04953..9a146632c5 100644
--- a/lib/tools/emacs/erlang-test.el
+++ b/lib/tools/emacs/erlang-test.el
@@ -33,6 +33,7 @@
(require 'ert)
(require 'cl-lib)
+(require 'erlang)
(defvar erlang-test-code
'((nil . "-module(erlang_test).")
@@ -51,27 +52,28 @@ concatenated to form an erlang file to test on.")
(ert-deftest erlang-test-tags ()
(let* ((dir (make-temp-file "erlang-test" t))
- (erlang-file (expand-file-name "erlang_test.erl" dir))
- (tags-file (expand-file-name "TAGS" dir))
- tags-file-name tags-table-list erlang-buffer)
- (unwind-protect
- (progn
- (erlang-test-create-erlang-file erlang-file)
- (erlang-test-compile-tags erlang-file tags-file)
- (setq erlang-buffer (find-file-noselect erlang-file))
- (with-current-buffer erlang-buffer
- (setq-local tags-file-name tags-file))
- ;; PENDING - setting global tags-file-name is a workaround
- ;; for GNU Emacs bug23164.
- (setq tags-file-name tags-file)
- (erlang-test-xref-find-definitions erlang-file erlang-buffer))
- (when (buffer-live-p erlang-buffer)
- (kill-buffer erlang-buffer))
- (let ((tags-buffer (find-buffer-visiting tags-file)))
- (when (buffer-live-p tags-buffer)
- (kill-buffer tags-buffer)))
- (when (file-exists-p dir)
- (delete-directory dir t)))))
+ (erlang-file (expand-file-name "erlang_test.erl" dir))
+ (tags-file (expand-file-name "TAGS" dir))
+ tags-file-name tags-table-list erlang-buffer)
+ (unwind-protect
+ (progn
+ (erlang-test-create-erlang-file erlang-file)
+ (erlang-test-compile-tags erlang-file tags-file)
+ (setq erlang-buffer (find-file-noselect erlang-file))
+ (with-current-buffer erlang-buffer
+ (setq-local tags-file-name tags-file))
+ ;; Setting global tags-file-name is a workaround for
+ ;; GNU Emacs bug#23164.
+ (setq tags-file-name tags-file)
+ (erlang-test-completion-table)
+ (erlang-test-xref-find-definitions erlang-file erlang-buffer))
+ (when (buffer-live-p erlang-buffer)
+ (kill-buffer erlang-buffer))
+ (let ((tags-buffer (find-buffer-visiting tags-file)))
+ (when (buffer-live-p tags-buffer)
+ (kill-buffer tags-buffer)))
+ (when (file-exists-p dir)
+ (delete-directory dir t)))))
(defun erlang-test-create-erlang-file (erlang-file)
(with-temp-file erlang-file
@@ -83,6 +85,19 @@ concatenated to form an erlang file to test on.")
"-o" tags-file
erlang-file))))
+(defun erlang-test-completion-table ()
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (setq tags-completion-table nil)
+ (tags-completion-table))
+ (should (equal (sort tags-completion-table #'string-lessp)
+ (sort (erlang-expected-completion-table) #'string-lessp))))
+
+(defun erlang-expected-completion-table ()
+ (append (cl-loop for (symbol . _) in erlang-test-code
+ when (stringp symbol)
+ append (list symbol (concat "erlang_test:" symbol)))
+ (list "erlang_test:" "erlang_test:module_info")))
+
(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
(cl-loop for (tagname . code) in erlang-test-code
for line = 1 then (1+ line)
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 3d20d86f43..a2062180f3 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -971,7 +971,7 @@ resulting regexp is surrounded by \\_< and \\_>."
(defvar erlang-defun-prompt-regexp (concat "^" erlang-atom-regexp "\\s *(")
"Regexp which should match beginning of a clause.")
-(defvar erlang-file-name-extension-regexp "\\.[eh]rl$"
+(defvar erlang-file-name-extension-regexp "\\.erl$"
"*Regexp which should match an Erlang file name.
This regexp is used when an Erlang module name is extracted from the
@@ -1291,6 +1291,11 @@ Unfortunately, XEmacs hasn't got support for a special Font
Lock syntax table. The effect is that `apply' in the atom
`foo_apply' will be highlighted as a bif.")
+(defvar erlang-replace-etags-tags-completion-table nil
+ "Internal flag used by advice `erlang-replace-tags-table'.
+This is non-nil when `etags-tags-completion-table' should be
+replaced by `erlang-etags-tags-completion-table'.")
+
;;; Avoid errors while compiling this file.
@@ -1354,6 +1359,10 @@ Lock syntax table. The effect is that `apply' in the atom
(called-interactively-p 'interactive)
(funcall (symbol-function 'interactive-p))))
+(unless (fboundp 'prog-mode)
+ (defun prog-mode ()
+ (use-local-map (make-keymap))))
+
;;;###autoload
(define-derived-mode erlang-mode prog-mode "Erlang"
"Major mode for editing Erlang source files in Emacs.
@@ -1539,7 +1548,9 @@ Other commands:
(set (make-local-variable 'outline-regexp) "[[:lower:]0-9_]+ *(.*) *-> *$")
(set (make-local-variable 'outline-level) (lambda () 1))
(set (make-local-variable 'add-log-current-defun-function)
- 'erlang-current-defun))
+ 'erlang-current-defun)
+ (set (make-local-variable 'find-tag-default-function)
+ 'erlang-find-tag-for-completion))
(defun erlang-font-lock-init ()
"Initialize Font Lock for Erlang mode."
@@ -4358,12 +4369,12 @@ works under XEmacs.)"
(require 'etags)
;; Test on a function available in the Emacs 19 version
;; of tags but not in the XEmacs version.
- (if (not (fboundp 'find-tag-noselect))
- ()
+ (when (fboundp 'find-tag-noselect)
(erlang-tags-define-keys (current-local-map))
(setq erlang-tags-installed t)))))
+
;; Set all keys bound to `find-tag' et.al. in the global map and the
;; menu to `erlang-find-tag' et.al. in `map'.
;;
@@ -4386,10 +4397,6 @@ works under XEmacs.)"
(erlang-menu-init))
-;; There exists a variable `find-tag-default-function'. It is not used
-;; since `complete-tag' uses it to get current word under point. In that
-;; situation we don't want the module to be prepended.
-
(defun erlang-find-tag-default ()
"Return the default tag.
Search `-import' list of imported functions.
@@ -4766,26 +4773,30 @@ for a tag on the form `module:tag'."
;;;
;;; The basic idea is to create a second completion table `erlang-tags-
;;; completion-table' containing all normal tags plus tags on the form
-;;; `module:tag'.
-
+;;; `module:tag' and `module:'.
-(when (and (fboundp 'etags-tags-completion-table)
+;; PENDING - Should probably make use of the
+;; `completion-at-point-functions' hook instead of this advice.
+(when (and (locate-library "etags")
+ (require 'etags)
+ (fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
(if (fboundp 'advice-add)
;; Emacs 24.4+
(advice-add 'etags-tags-completion-table :around
(lambda (oldfun)
- (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
+ (if erlang-replace-etags-tags-completion-table
(erlang-etags-tags-completion-table)
(funcall oldfun)))
(list :name 'erlang-replace-tags-table))
;; Emacs 23.1-24.3
- (defadvice etags-tags-completion-table (around erlang-replace-tags-table activate)
- (if (eq find-tag-default-function 'erlang-find-tag-for-completion)
+ (defadvice etags-tags-completion-table (around
+ erlang-replace-tags-table
+ activate)
+ (if erlang-replace-etags-tags-completion-table
(setq ad-return-value (erlang-etags-tags-completion-table))
ad-do-it))))
-
(defun erlang-complete-tag ()
"Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
@@ -4799,23 +4810,19 @@ about Erlang modules."
(cond ((and erlang-tags-installed
(fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
- ;; This depends on the advice called
- ;; erlang-replace-tags-table above. It is not enough to
- ;; let-bind tags-completion-table-function since that may be
- ;; overwritten in etags-recognize-tags-table.
- (let ((find-tag-default-function 'erlang-find-tag-for-completion))
+ (let ((erlang-replace-etags-tags-completion-table t))
(complete-tag)))
((and erlang-tags-installed
- (fboundp 'complete-tag)
- (fboundp 'tags-complete-tag)) ; Emacs 19
+ (fboundp 'complete-tag)
+ (fboundp 'tags-complete-tag)) ; Emacs 19-22
(let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag)))
(fset 'tags-complete-tag
(symbol-function 'erlang-tags-complete-tag))
(unwind-protect
- (funcall (symbol-function 'complete-tag))
+ (complete-tag)
(fset 'tags-complete-tag orig-tags-complete-tag))))
((fboundp 'complete-tag) ; Emacs 19
- (funcall (symbol-function 'complete-tag)))
+ (complete-tag))
((fboundp 'tag-complete-symbol) ; XEmacs
(funcall (symbol-function 'tag-complete-symbol)))
(t
@@ -4830,19 +4837,22 @@ about Erlang modules."
(buffer-substring-no-properties start (point)))))
-
;; Based on `tags-complete-tag', but this one uses
;; `erlang-tags-completion-table' instead of `tags-completion-table'.
;;
;; This is the entry-point called by system function `completing-read'.
+;;
+;; Used for minibuffer completion in Emacs 19-24 and completion in
+;; erlang buffers in Emacs 19-22.
(defun erlang-tags-complete-tag (string predicate what)
- (save-excursion
- ;; If we need to ask for the tag table, allow that.
- (let ((enable-recursive-minibuffers t))
- (visit-tags-table-buffer))
+ (with-current-buffer (window-buffer (minibuffer-selected-window))
+ (save-excursion
+ ;; If we need to ask for the tag table, allow that.
+ (let ((enable-recursive-minibuffers t))
+ (visit-tags-table-buffer))
(if (eq what t)
(all-completions string (erlang-tags-completion-table) predicate)
- (try-completion string (erlang-tags-completion-table) predicate))))
+ (try-completion string (erlang-tags-completion-table) predicate)))))
;; `tags-completion-table' calls itself recursively, make it
@@ -4860,7 +4870,6 @@ about Erlang modules."
(fset 'tags-completion-table
erlang-tags-orig-completion-table)))
-
(defun erlang-tags-completion-table-1 ()
(make-local-variable 'erlang-tags-completion-table)
(or erlang-tags-completion-table
@@ -4871,60 +4880,63 @@ about Erlang modules."
(setq erlang-tags-completion-table tags-completion-table))))
+
+;; Emacs 25 expects this function to return a list (and it is ok for
+;; it to include duplicates). Older emacsen expects an obarray.
+(defun erlang-etags-tags-completion-table ()
+ (if (>= emacs-major-version 25)
+ (erlang-etags-tags-completion-table-list)
+ (let ((obarray (make-vector 511 0)))
+ (dolist (tag (erlang-etags-tags-completion-table-list))
+ (intern tag obarray))
+ obarray)))
+
;; Based on `etags-tags-completion-table'. The difference is that we
-;; add three symbols to the vector, the tag, module: and module:tag.
+;; add three strings to the list, the tag, module: and module:tag.
;; The module is extracted from the file name of a tag. (This one
;; only works if we are looking at an `etags' file. However, this is
;; the only format supported by Emacs, so far.)
-(defun erlang-etags-tags-completion-table ()
- (let ((table (make-vector 511 0))
- (file nil)
- (progress-reporter
- (when (fboundp 'make-progress-reporter)
- (make-progress-reporter
- (format "Making erlang tags completion table for %s..." buffer-file-name)
- (point-min) (point-max)))))
+(defun erlang-etags-tags-completion-table-list ()
+ (let ((progress-reporter
+ (make-progress-reporter
+ (format "Making tags completion table for %s..." buffer-file-name)
+ (point-min) (point-max)))
+ table module)
(save-excursion
(goto-char (point-min))
- ;; This monster regexp matches an etags tag line.
- ;; \1 is the string to match;
- ;; \2 is not interesting;
- ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN
- ;; \4 is not interesting;
- ;; \5 is the explicitly-specified tag name.
- ;; \6 is the line to start searching at;
- ;; \7 is the char to start searching at.
(while (progn
- (while (and
- (eq (following-char) ?\f)
- (looking-at "\f\n\\([^,\n]*\\),.*\n"))
- (setq file (buffer-substring
- (match-beginning 1) (match-end 1)))
- (goto-char (match-end 0)))
+ (while (and (eq (following-char) ?\f)
+ (looking-at "\f\n\\([^,\n]*\\),.*\n"))
+ (let ((file (buffer-substring (match-beginning 1)
+ (match-end 1))))
+ (setq module (erlang-get-module-from-file-name file))
+ (when module
+ (push (concat module ":") table)
+ (push (concat module ":module_info") table))
+ (forward-line 2)))
+ ;; This regexp matches an explicit tag name or the
+ ;; place where it would start.
(re-search-forward
- "\
-^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
-\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
-\\([0-9]+\\)?,\\([0-9]+\\)?\n"
+ "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?"
nil t))
- (let ((tag (if (match-beginning 5)
+ (let ((tag (if (match-beginning 1)
;; There is an explicit tag name.
- (buffer-substring (match-beginning 5) (match-end 5))
- ;; No explicit tag name. Best guess.
- (buffer-substring (match-beginning 3) (match-end 3))))
- (module (and file
- (erlang-get-module-from-file-name file))))
- (intern tag table)
+ (buffer-substring (match-beginning 1) (match-end 1))
+ ;; No explicit tag name. Backtrack a little,
+ ;; and look for the implicit one.
+ (goto-char (match-beginning 0))
+ (skip-chars-backward "^\f\t\n\r()=,; ")
+ (buffer-substring (point) (match-beginning 0)))))
+ (forward-line 1)
+ (push tag table)
(when (stringp module)
- (intern (concat module ":" tag) table)
- ;; Only the first ones will be stored in the table.
- (intern (concat module ":") table)
- (intern (concat module ":module_info") table))
- (when progress-reporter
- (progress-reporter-update progress-reporter (point))))))
+ (push (concat module ":" tag) table))
+ (progress-reporter-update progress-reporter (point)))))
table))
+
+
;;; Xref backend erlang-etags
;; In GNU Emacs 25 xref was introduced. It is a framework for cross
@@ -4963,10 +4975,12 @@ about Erlang modules."
((_backend (eql erlang-etags)) identifier)
(erlang-xref-find-definitions identifier t))
- ;; PENDING - This remains to be properly implemented.
(cl-defmethod xref-backend-identifier-completion-table
((_backend (eql erlang-etags)))
- (tags-lazy-completion-table)))))
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (tags-completion-table))))))
+
+
(defun erlang-xref-find-definitions (identifier &optional is-regexp)
diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile
index 6aa9d8d340..7f9cec540b 100644
--- a/system/doc/top/Makefile
+++ b/system/doc/top/Makefile
@@ -121,10 +121,11 @@ $(HTMLDIR)/index.html + $(HTMLDIR)/applications.html: $(INDEX_SCRIPT) $(TEMPLATE
# Check if we are building the index from source or an installed release
if test "$$RELEASE_ROOT" = "" ; then \
$(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index src $(ERL_TOP) \
- $(HTMLDIR) $(SYSTEM_VSN) -s erlang halt ;\
+ $(HTMLDIR) `cat "$(ERL_TOP)/OTP_VERSION"` -s erlang halt ;\
else \
$(ERL) -noshell -pa $(EBIN) -s erl_html_tools top_index rel $(RELEASE_ROOT) \
- $(HTMLDIR) $(SYSTEM_VSN) -s erlang halt ;\
+ $(HTMLDIR) `cat "$(RELEASE_ROOT)/releases/$(SYSTEM_VSN)/OTP_VERSION"` \
+ -s erlang halt ;\
fi
diff --git a/system/doc/top/src/erl_html_tools.erl b/system/doc/top/src/erl_html_tools.erl
index ab58fdf666..d55c2e1164 100644
--- a/system/doc/top/src/erl_html_tools.erl
+++ b/system/doc/top/src/erl_html_tools.erl
@@ -54,24 +54,24 @@ top_index() ->
top_index(src, Value, filename:join(Value, "doc"), RelName)
end.
-top_index([src, RootDir, DestDir, OtpRel])
- when is_atom(RootDir), is_atom(DestDir), is_atom(OtpRel) ->
- top_index(src, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpRel));
-top_index([rel, RootDir, DestDir, OtpRel])
- when is_atom(RootDir), is_atom(DestDir), is_atom(OtpRel) ->
- top_index(rel, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpRel));
+top_index([src, RootDir, DestDir, OtpBaseVsn])
+ when is_atom(RootDir), is_atom(DestDir), is_atom(OtpBaseVsn) ->
+ top_index(src, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpBaseVsn));
+top_index([rel, RootDir, DestDir, OtpBaseVsn])
+ when is_atom(RootDir), is_atom(DestDir), is_atom(OtpBaseVsn) ->
+ top_index(rel, atom_to_list(RootDir), atom_to_list(DestDir), atom_to_list(OtpBaseVsn));
top_index(RootDir) when is_atom(RootDir) ->
{_,RelName} = init:script_id(),
top_index(rel, RootDir, filename:join(RootDir, "doc"), RelName).
-top_index(Source, RootDir, DestDir, OtpRel) ->
+top_index(Source, RootDir, DestDir, OtpBaseVsn) ->
report("****\nRootDir: ~p", [RootDir]),
report("****\nDestDir: ~p", [DestDir]),
- report("****\nOtpRel: ~p", [OtpRel]),
+ report("****\nOtpBaseVsn: ~p", [OtpBaseVsn]),
- put(otp_release, OtpRel),
+ put(otp_base_vsn, OtpBaseVsn),
Templates = find_templates(["","templates",DestDir]),
report("****\nTemplates: ~p", [Templates]),
@@ -81,9 +81,9 @@ top_index(Source, RootDir, DestDir, OtpRel) ->
report("****\nGroups: ~p", [Groups]),
process_templates(Templates, DestDir, Groups).
-top_index_silent(RootDir, DestDir, OtpRel) ->
+top_index_silent(RootDir, DestDir, OtpBaseVsn) ->
put(silent,true),
- Result = top_index(rel, RootDir, DestDir, OtpRel),
+ Result = top_index(rel, RootDir, DestDir, OtpBaseVsn),
erase(silent),
Result.
@@ -361,7 +361,7 @@ subst_template_1(Group, Stream, Info) ->
case file:read(Stream, 100000) of
{ok, Template} ->
Fun = fun(Match, _) -> {subst(Match, Info, Group),Info} end,
- gsub(Template, "#[A-Za-z0-9]+#", Fun, Info);
+ gsub(Template, "#[A-Za-z_0-9]+#", Fun, Info);
{error, Reason} ->
{error, Reason}
end.
@@ -379,8 +379,8 @@ get_version(Info) ->
""
end.
-subst("#release#", _Info, _Group) ->
- get(otp_release);
+subst("#otp_base_vsn#", _Info, _Group) ->
+ get(otp_base_vsn);
subst("#version#", Info, _Group) ->
get_version(Info);
subst("#copyright#", _Info, _Group) ->
diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src
index 0849fd8a0e..2ece44b15f 100644
--- a/system/doc/top/templates/index.html.src
+++ b/system/doc/top/templates/index.html.src
@@ -22,7 +22,7 @@ limitations under the License.
<html>
<head>
<link rel="stylesheet" href="otp_doc.css" type="text/css"/>
- <title>Erlang/OTP #release#</title>
+ <title>Erlang/OTP #otp_base_vsn#</title>
<script id="js" type="text/javascript" language="JavaScript" src="js/flipmenu/flipmenu.js">
@@ -74,7 +74,7 @@ limitations under the License.
<div id="content">
<div class="innertube">
<center>
-<font size="+1"><b>Erlang/OTP #release#</b></font><br>
+<font size="+1"><b>Erlang/OTP #otp_base_vsn#</b></font><br>
</center>
<center>
<p>
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 23:07:53 +0000