aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/doc/src/erlang.xml53
-rw-r--r--erts/emulator/beam/atom.names4
-rw-r--r--erts/emulator/beam/beam_bif_load.c67
-rw-r--r--erts/emulator/beam/beam_emu.c42
-rw-r--r--erts/emulator/beam/beam_load.c118
-rw-r--r--erts/emulator/beam/erl_alloc.types1
-rw-r--r--erts/emulator/beam/erl_gc.c6
-rw-r--r--erts/emulator/beam/erl_message.c17
-rw-r--r--erts/emulator/beam/erl_message.h11
-rw-r--r--erts/emulator/beam/erl_nif.c14
-rw-r--r--erts/emulator/beam/erl_process.c8
-rw-r--r--erts/emulator/beam/erl_process.h38
-rw-r--r--erts/emulator/beam/erl_time_sup.c6
-rw-r--r--erts/emulator/beam/global.h8
-rw-r--r--erts/emulator/beam/utils.c3
-rw-r--r--erts/emulator/sys/common/erl_poll.c14
-rw-r--r--erts/emulator/test/after_SUITE.erl4
-rw-r--r--erts/emulator/test/alloc_SUITE.erl2
-rw-r--r--erts/emulator/test/busy_port_SUITE.erl6
-rw-r--r--erts/emulator/test/dirty_nif_SUITE.erl12
-rw-r--r--erts/emulator/test/distribution_SUITE.erl10
-rw-r--r--erts/emulator/test/driver_SUITE.erl12
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl2
-rw-r--r--erts/emulator/test/estone_SUITE.erl2
-rw-r--r--erts/emulator/test/float_SUITE.erl2
-rw-r--r--erts/emulator/test/long_timers_test.erl188
-rw-r--r--erts/emulator/test/message_queue_data_SUITE.erl2
-rw-r--r--erts/emulator/test/monitor_SUITE.erl2
-rw-r--r--erts/emulator/test/mtx_SUITE.erl2
-rw-r--r--erts/emulator/test/nif_SUITE.erl21
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c48
-rw-r--r--erts/emulator/test/node_container_SUITE.erl2
-rw-r--r--erts/emulator/test/old_scheduler_SUITE.erl4
-rw-r--r--erts/emulator/test/port_SUITE.erl6
-rw-r--r--erts/emulator/test/process_SUITE.erl6
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl73
-rw-r--r--erts/emulator/test/signal_SUITE.erl2
-rw-r--r--erts/emulator/test/smoke_test_SUITE.erl2
-rw-r--r--erts/emulator/test/statistics_SUITE.erl17
-rw-r--r--erts/emulator/test/system_info_SUITE.erl2
-rw-r--r--erts/emulator/test/time_SUITE.erl12
-rw-r--r--erts/emulator/test/timer_bif_SUITE.erl20
-rw-r--r--erts/emulator/test/trace_bif_SUITE.erl4
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl6
-rw-r--r--erts/emulator/test/z_SUITE.erl8
-rw-r--r--erts/example/time_compat.erl4
-rw-r--r--erts/include/internal/erl_misc_utils.h29
-rw-r--r--erts/lib_src/pthread/ethr_event.c74
-rw-r--r--erts/preloaded/ebin/erlang.beambin104816 -> 105100 bytes
-rw-r--r--erts/preloaded/src/erlang.erl31
-rw-r--r--erts/test/z_SUITE.erl14
-rw-r--r--lib/common_test/src/ct_make.erl2
-rw-r--r--lib/common_test/src/erl2html2.erl2
-rw-r--r--lib/common_test/test/ct_auto_compile_SUITE.erl1
-rw-r--r--lib/crypto/c_src/crypto.c54
-rw-r--r--lib/crypto/doc/src/crypto.xml21
-rw-r--r--lib/crypto/src/crypto.erl14
-rw-r--r--lib/crypto/test/crypto_SUITE.erl97
-rw-r--r--lib/dialyzer/src/dialyzer_contracts.erl12
-rw-r--r--lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options1
-rw-r--r--lib/dialyzer/test/opaque_SUITE_data/dialyzer_options1
-rw-r--r--lib/erl_interface/src/connect/ei_connect.c40
-rw-r--r--lib/erl_interface/src/misc/ei_portio.h2
-rw-r--r--lib/hipe/cerl/erl_types.erl4
-rw-r--r--lib/kernel/doc/src/heart.xml2
-rw-r--r--lib/kernel/doc/src/kernel_app.xml4
-rw-r--r--lib/observer/src/observer_tv_wx.erl22
-rw-r--r--lib/observer/src/observer_wx.erl8
-rw-r--r--lib/ssh/src/ssh.app.src2
-rw-r--r--lib/ssh/src/ssh.erl123
-rw-r--r--lib/ssh/src/ssh.hrl2
-rw-r--r--lib/ssh/src/ssh_auth.erl21
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl92
-rw-r--r--lib/ssh/test/ssh_algorithms_SUITE.erl18
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/src/ssl.app.src2
-rw-r--r--lib/ssl/src/ssl.appup.src21
-rw-r--r--lib/ssl/src/ssl_connection.erl2
-rw-r--r--lib/ssl/src/tls_connection.erl59
-rw-r--r--lib/ssl/src/tls_handshake.erl39
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl7
-rw-r--r--lib/ssl/test/ssl_crl_SUITE.erl2
-rw-r--r--lib/ssl/test/ssl_packet_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_payload_SUITE.erl9
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl3
-rw-r--r--lib/ssl/test/ssl_upgrade_SUITE.erl20
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/queue.xml2
-rw-r--r--lib/stdlib/src/beam_lib.erl2
-rw-r--r--lib/stdlib/vsn.mk2
-rw-r--r--lib/tools/emacs/erlang-test.el106
-rw-r--r--lib/tools/emacs/erlang.el112
-rw-r--r--lib/tools/src/make.erl2
-rw-r--r--lib/tools/src/tools.app.src2
-rw-r--r--lib/tools/test/make_SUITE_data/test1.erl2
-rw-r--r--lib/tools/vsn.mk2
96 files changed, 1402 insertions, 588 deletions
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 51ebddc155..18f1b2e833 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -84,22 +84,22 @@
<p>Time unit expressed in parts per second. That is,
the time unit equals <c>1/PartsPerSecond</c> second.</p>
</item>
- <tag><c>seconds</c></tag>
+ <tag><c>second</c></tag>
<item>
<p>Symbolic representation of the time unit
represented by the integer <c>1</c>.</p>
</item>
- <tag><c>milli_seconds</c></tag>
+ <tag><c>millisecond</c></tag>
<item>
<p>Symbolic representation of the time unit
represented by the integer <c>1000</c>.</p>
</item>
- <tag><c>micro_seconds</c></tag>
+ <tag><c>microsecond</c></tag>
<item>
<p>Symbolic representation of the time unit
represented by the integer <c>1000000</c>.</p>
</item>
- <tag><c>nano_seconds</c></tag>
+ <tag><c>nanosecond</c></tag>
<item>
<p>Symbolic representation of the time unit
represented by the integer <c>1000000000</c>.</p>
@@ -119,7 +119,7 @@
<p>One can get an approximation of the <c>native</c>
time unit by calling
<seealso marker="erlang:convert_time_unit/3">
- <c>erlang:convert_time_unit(1, seconds, native)</c></seealso>.
+ <c>erlang:convert_time_unit(1, second, native)</c></seealso>.
The result equals the number
of whole <c>native</c> time units per second. If
the number of <c>native</c> time units per second does not
@@ -149,6 +149,10 @@
<seealso marker="kernel:os#perf_counter/0">
<c>os:perf_counter/0</c></seealso>.</p>
</item>
+ <tag><seealso marker="#type_deprecated_time_unit"><c>deprecated_time_unit()</c></seealso></tag>
+ <item><p>
+ Deprecated symbolic representations kept for backwards-compatibility.
+ </p></item>
</taglist>
<p>The <c>time_unit/0</c> type can be extended.
To convert time values between time units, use
@@ -156,6 +160,27 @@
<c>erlang:convert_time_unit/3</c></seealso>.</p>
</desc>
</datatype>
+ <datatype>
+ <name name="deprecated_time_unit"></name>
+ <desc><marker id="type_deprecated_time_unit"/>
+ <p>The <seealso marker="#type_time_unit"><c>time_unit()</c></seealso>
+ type also consist of the following <em>deprecated</em> symbolic
+ time units:</p>
+ <taglist>
+ <tag><c>seconds</c></tag>
+ <item><p>Same as <seealso marker="#type_time_unit"><c>second</c></seealso>.</p></item>
+
+ <tag><c>milli_seconds</c></tag>
+ <item><p>Same as <seealso marker="#type_time_unit"><c>millisecond</c></seealso>.</p></item>
+
+ <tag><c>micro_seconds</c></tag>
+ <item><p>Same as <seealso marker="#type_time_unit"><c>microsecond</c></seealso>.</p></item>
+
+ <tag><c>nano_seconds</c></tag>
+ <item><p>Same as <seealso marker="#type_time_unit"><c>nanosecond</c></seealso>.</p></item>
+ </taglist>
+ </desc>
+ </datatype>
</datatypes>
<funcs>
@@ -4430,12 +4455,12 @@ RealSystem = system + MissedSystem</code>
</desc>
</func>
- <marker id="process_flag_min_heap_size"/>
<func>
<name name="process_flag" arity="2" clause_i="3"/>
<fsummary>Set process flag min_heap_size for the calling process.
</fsummary>
<desc>
+ <marker id="process_flag_min_heap_size"/>
<p>Changes the minimum heap size for the calling process.</p>
<p>Returns the old value of the flag.</p>
</desc>
@@ -4452,13 +4477,13 @@ RealSystem = system + MissedSystem</code>
</desc>
</func>
- <marker id="process_flag_max_heap_size"/>
<func>
<name name="process_flag" arity="2" clause_i="5"/>
<fsummary>Set process flag max_heap_size for the calling process.
</fsummary>
<type name="max_heap_size"/>
<desc>
+ <marker id="process_flag_max_heap_size"/>
<p>This flag sets the maximum heap size for the calling process.
If <c><anno>MaxHeapSize</anno></c> is an integer, the system default
values for <c>kill</c> and <c>error_logger</c> are used.
@@ -4526,13 +4551,13 @@ RealSystem = system + MissedSystem</code>
</desc>
</func>
- <marker id="process_flag_message_queue_data"/>
<func>
<name name="process_flag" arity="2" clause_i="6"/>
<fsummary>Set process flag message_queue_data for the calling process.
</fsummary>
<type name="message_queue_data"/>
<desc>
+ <marker id="process_flag_message_queue_data"/>
<p>This flag determines how messages in the message queue
are stored, as follows:</p>
<taglist>
@@ -6720,12 +6745,12 @@ ok
</desc>
</func>
- <marker id="system_flag_max_heap_size"></marker>
<func>
<name name="system_flag" arity="2" clause_i="8"/>
<fsummary>Set system flag max_heap_size.</fsummary>
<type name="max_heap_size"/>
<desc>
+ <marker id="system_flag_max_heap_size"></marker>
<p>
Sets the default maximum heap size settings for processes.
The size is specified in words. The new <c>max_heap_size</c>
@@ -8474,7 +8499,7 @@ ok
<seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
monotonic time</seealso>. The time stamp (Ts) has the same
format and value as produced by
- <c>erlang:monotonic_time(nano_seconds)</c>.</p>
+ <c>erlang:monotonic_time(nanosecond)</c>.</p>
</item>
<tag><c>runnable_procs</c></tag>
<item>
@@ -8502,7 +8527,7 @@ ok
<seealso marker="time_correction#Erlang_Monotonic_Time">Erlang
monotonic time</seealso> and a monotonically increasing
integer. The time stamp (Ts) has the same format and value
- as produced by <c>{erlang:monotonic_time(nano_seconds),
+ as produced by <c>{erlang:monotonic_time(nanosecond),
erlang:unique_integer([monotonic])}</c>.</p>
</item>
<tag><c>timestamp</c></tag>
@@ -8732,7 +8757,7 @@ ok
<p>The <c>erlang:timestamp()</c> BIF is equivalent to:</p>
<code type="none">
timestamp() ->
- ErlangSystemTime = erlang:system_time(micro_seconds),
+ ErlangSystemTime = erlang:system_time(microsecond),
MegaSecs = ErlangSystemTime div 1000000000000,
Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000,
MicroSecs = ErlangSystemTime rem 1000000,
@@ -9013,7 +9038,7 @@ timestamp() ->
monotonic time</seealso> time stamp in all trace messages. The
time stamp (Ts) has the same format and value as produced by
<seealso marker="#monotonic_time-1">
- <c>erlang:monotonic_time(nano_seconds)</c></seealso>.
+ <c>erlang:monotonic_time(nanosecond)</c></seealso>.
This flag overrides flag <c>cpu_timestamp</c>.</p>
</item>
<tag><c>strict_monotonic_timestamp</c></tag>
@@ -9024,7 +9049,7 @@ timestamp() ->
integer in all trace messages. The time stamp (Ts) has the
same format and value as produced by <c>{</c>
<seealso marker="#monotonic_time-1">
- <c>erlang:monotonic_time(nano_seconds)</c></seealso><c>,</c>
+ <c>erlang:monotonic_time(nanosecond)</c></seealso><c>,</c>
<seealso marker="#unique_integer-1">
<c>erlang:unique_integer([monotonic])</c></seealso><c>}</c>.
This flag overrides flag <c>cpu_timestamp</c>.</p>
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 89c42f4700..9dae67cb2d 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -389,8 +389,10 @@ atom merge_trap
atom meta
atom meta_match_spec
atom micro_seconds
+atom microsecond
atom microstate_accounting
atom milli_seconds
+atom millisecond
atom min_heap_size
atom min_bin_vheap_size
atom minor_version
@@ -407,6 +409,7 @@ atom more
atom multi_scheduling
atom multiline
atom nano_seconds
+atom nanosecond
atom name
atom named_table
atom namelist
@@ -562,6 +565,7 @@ atom schedulers_online
atom scheme
atom scientific
atom scope
+atom second
atom seconds
atom send_to_non_existing_process
atom sensitive
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 10759c1f57..115005e857 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -57,11 +57,13 @@ static struct {
Process *erts_code_purger = NULL;
-ErtsLiteralArea *erts_copy_literal_area = NULL;
#ifdef ERTS_DIRTY_SCHEDULERS
Process *erts_dirty_process_code_checker;
#endif
-
+erts_smp_atomic_t erts_copy_literal_area__;
+#define ERTS_SET_COPY_LITERAL_AREA(LA) \
+ erts_smp_atomic_set_nob(&erts_copy_literal_area__, \
+ (erts_aint_t) (LA))
Process *erts_literal_area_collector = NULL;
typedef struct ErtsLiteralAreaRef_ ErtsLiteralAreaRef;
@@ -109,6 +111,8 @@ erts_beam_bif_load_init(void)
erts_smp_mtx_init(&release_literal_areas.mtx, "release_literal_areas");
release_literal_areas.first = NULL;
release_literal_areas.last = NULL;
+ erts_smp_atomic_init_nob(&erts_copy_literal_area__,
+ (erts_aint_t) NULL);
init_purge_state();
}
@@ -862,7 +866,7 @@ erts_proc_copy_literal_area(Process *c_p, int *redsp, int fcalls, int gc_allowed
Uint lit_bsize;
ErlHeapFragment *hfrag;
- la = erts_copy_literal_area;
+ la = ERTS_COPY_LITERAL_AREA();
if (!la)
return am_ok;
@@ -1206,21 +1210,39 @@ hfrag_literal_copy(Eterm **hpp, ErlOffHeap *ohp,
}
}
+#ifdef ERTS_SMP
+
ErtsThrPrgrLaterOp later_literal_area_switch;
-#ifdef ERTS_SMP
+typedef struct {
+ ErtsThrPrgrLaterOp lop;
+ ErtsLiteralArea *la;
+} ErtsLaterReleasLiteralArea;
+
+static void
+later_release_literal_area(void *vlrlap)
+{
+ ErtsLaterReleasLiteralArea *lrlap;
+ lrlap = (ErtsLaterReleasLiteralArea *) vlrlap;
+ erts_release_literal_area(lrlap->la);
+ erts_free(ERTS_ALC_T_RELEASE_LAREA, vlrlap);
+}
+
static void
-complete_literal_area_switch(void *unused)
+complete_literal_area_switch(void *literal_area)
{
Process *p = erts_literal_area_collector;
erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS);
erts_resume(p, ERTS_PROC_LOCK_STATUS);
erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS);
+ if (literal_area)
+ erts_release_literal_area((ErtsLiteralArea *) literal_area);
}
#endif
BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
{
+ ErtsLiteralArea *unused_la;
ErtsLiteralAreaRef *la_ref;
if (BIF_P != erts_literal_area_collector)
@@ -1237,26 +1259,45 @@ BIF_RETTYPE erts_internal_release_literal_area_switch_0(BIF_ALIST_0)
erts_smp_mtx_unlock(&release_literal_areas.mtx);
- if (erts_copy_literal_area)
- erts_release_literal_area(erts_copy_literal_area);
+ unused_la = ERTS_COPY_LITERAL_AREA();
if (!la_ref) {
- erts_copy_literal_area = NULL;
+ ERTS_SET_COPY_LITERAL_AREA(NULL);
+ if (unused_la) {
+#ifdef ERTS_SMP
+ ErtsLaterReleasLiteralArea *lrlap;
+ lrlap = erts_alloc(ERTS_ALC_T_RELEASE_LAREA,
+ sizeof(ErtsLaterReleasLiteralArea));
+ lrlap->la = unused_la;
+ erts_schedule_thr_prgr_later_cleanup_op(
+ later_release_literal_area,
+ (void *) lrlap,
+ &lrlap->lop,
+ (sizeof(ErtsLaterReleasLiteralArea)
+ + sizeof(ErtsLiteralArea)
+ + ((unused_la->end
+ - &unused_la->start[0])
+ - 1)*(sizeof(Eterm))));
+#else
+ erts_release_literal_area(unused_la);
+#endif
+ }
BIF_RET(am_false);
}
- erts_copy_literal_area = la_ref->literal_area;
+ ERTS_SET_COPY_LITERAL_AREA(la_ref->literal_area);
erts_free(ERTS_ALC_T_LITERAL_REF, la_ref);
-#ifndef ERTS_SMP
- BIF_RET(am_true);
-#else
+#ifdef ERTS_SMP
erts_schedule_thr_prgr_later_op(complete_literal_area_switch,
- NULL,
+ unused_la,
&later_literal_area_switch);
erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL);
ERTS_BIF_YIELD_RETURN(BIF_P, am_true);
+#else
+ erts_release_literal_area(unused_la);
+ BIF_RET(am_true);
#endif
}
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 3b12f78ced..c704323bb2 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -1960,6 +1960,8 @@ void process_main(void)
ErtsMessage* msgp;
PROCESS_MAIN_CHK_LOCKS(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
+
PreFetch(0, next);
msgp = PEEK_MESSAGE(c_p);
@@ -2047,6 +2049,7 @@ void process_main(void)
}
ERTS_DBG_CHK_REDS(c_p, FCALLS);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2583,7 +2586,9 @@ do { \
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2614,7 +2619,9 @@ do { \
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2644,7 +2651,9 @@ do { \
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2685,7 +2694,9 @@ do { \
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2728,7 +2739,9 @@ do { \
SWAPOUT;
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p);
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, live);
+ ERTS_CHK_MBUF_SZ(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2766,7 +2779,9 @@ do { \
c_p->fcalls = FCALLS;
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2793,7 +2808,9 @@ do { \
bf = (BifFunction) Arg(0);
PROCESS_MAIN_CHK_LOCKS(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, tmp_reg);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
@@ -2843,7 +2860,9 @@ do { \
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
ERTS_HOLE_CHECK(c_p);
@@ -3556,11 +3575,13 @@ do { \
ASSERT(c_p->scheduler_data);
#endif
live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
erts_pre_nif(&env, c_p, (struct erl_module_nif*)I[2], NULL);
nif_bif_result = (*fp)(&env, bif_nif_arity, reg);
if (env.exception_thrown)
nif_bif_result = THE_NON_VALUE;
erts_post_nif(&env);
+ ERTS_CHK_MBUF_SZ(c_p);
PROCESS_MAIN_CHK_LOCKS(c_p);
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
@@ -3612,7 +3633,9 @@ do { \
Eterm (*bf)(Process*, Eterm*, BeamInstr*) = vbf;
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
live_hf_end = c_p->mbuf;
+ ERTS_CHK_MBUF_SZ(c_p);
nif_bif_result = (*bf)(c_p, reg, I);
+ ERTS_CHK_MBUF_SZ(c_p);
ASSERT(!ERTS_PROC_IS_EXITING(c_p) ||
is_non_value(nif_bif_result));
ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p);
@@ -5252,19 +5275,14 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp)
else {
/*
* Dirty CPU scheduler:
- * Currently two reductions consumed per
- * micro second spent in the dirty NIF.
+ * Reductions based on time consumed by
+ * the dirty NIF.
*/
- ErtsMonotonicTime time;
- time = erts_get_monotonic_time(esdp);
- time -= start_time;
- time = ERTS_MONOTONIC_TO_USEC(time);
- time *= (CONTEXT_REDS-1)/1000 + 1;
- ASSERT(time >= 0);
- if (time == 0)
- time = 1; /* At least one reduction */
- time += esdp->virtual_reds;
- reds_used = time > INT_MAX ? INT_MAX : (int) time;
+ Sint64 treds;
+ treds = erts_time2reds(start_time,
+ erts_get_monotonic_time(esdp));
+ treds += esdp->virtual_reds;
+ reds_used = treds > INT_MAX ? INT_MAX : (int) treds;
}
PROCESS_MAIN_CHK_LOCKS(c_p);
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index f5aa9e1c0c..5810cce4c7 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -105,7 +105,7 @@ typedef struct {
*/
typedef struct genop {
- int op; /* Opcode. */
+ unsigned int op; /* Opcode. */
int arity; /* Number of arguments. */
GenOpArg def_args[MAX_OPARGS]; /* Default buffer for arguments. */
GenOpArg* a; /* The arguments. */
@@ -283,8 +283,8 @@ typedef struct LoaderState {
byte* code_start; /* Start of code file. */
unsigned code_size; /* Size of code file. */
int specific_op; /* Specific opcode (-1 if not found). */
- int num_functions; /* Number of functions in module. */
- int num_labels; /* Number of labels. */
+ unsigned int num_functions; /* Number of functions in module. */
+ unsigned int num_labels; /* Number of labels. */
BeamCodeHeader* hdr; /* Loaded code header */
BeamInstr* codev; /* Loaded code buffer */
int codev_size; /* Size of code buffer in words. */
@@ -303,13 +303,13 @@ typedef struct LoaderState {
* Atom table.
*/
- int num_atoms; /* Number of atoms in atom table. */
+ unsigned int num_atoms; /* Number of atoms in atom table. */
Eterm* atom; /* Atom table. */
- int num_exps; /* Number of exports. */
+ unsigned int num_exps; /* Number of exports. */
ExportEntry* export; /* Pointer to export table. */
- int num_imports; /* Number of imports. */
+ unsigned int num_imports; /* Number of imports. */
ImportEntry* import; /* Import entry (translated information). */
/*
@@ -323,8 +323,8 @@ typedef struct LoaderState {
* Lambda table.
*/
- int num_lambdas; /* Number of lambdas in table. */
- int lambdas_allocated; /* Size of allocated lambda table. */
+ unsigned int num_lambdas; /* Number of lambdas in table. */
+ unsigned int lambdas_allocated; /* Size of allocated lambda table. */
Lambda* lambdas; /* Pointer to lambdas. */
Lambda def_lambdas[16]; /* Default storage for lambda table. */
char* lambda_error; /* Delayed missing 'FunT' error. */
@@ -333,8 +333,8 @@ typedef struct LoaderState {
* Literals (constant pool).
*/
- int num_literals; /* Number of literals in table. */
- int allocated_literals; /* Number of literal entries allocated. */
+ unsigned int num_literals; /* Number of literals in table. */
+ unsigned int allocated_literals; /* Number of literal entries allocated. */
Literal* literals; /* Array of literals. */
LiteralPatch* literal_patches; /* Operands that need to be patched. */
Uint total_literal_size; /* Total heap size for all literals. */
@@ -343,13 +343,13 @@ typedef struct LoaderState {
* Line table.
*/
BeamInstr* line_item; /* Line items from the BEAM file. */
- int num_line_items; /* Number of line items. */
+ unsigned int num_line_items;/* Number of line items. */
LineInstr* line_instr; /* Line instructions */
- int num_line_instrs; /* Maximum number of line instructions */
- int current_li; /* Current line instruction */
- int* func_line; /* Mapping from function to first line instr */
+ unsigned int num_line_instrs; /* Maximum number of line instructions */
+ unsigned int current_li; /* Current line instruction */
+ unsigned int* func_line; /* Mapping from function to first line instr */
Eterm* fname; /* List of file names */
- int num_fnames; /* Number of filenames in fname table */
+ unsigned int num_fnames; /* Number of filenames in fname table */
int loc_size; /* Size of location info in bytes (2/4) */
} LoaderState;
@@ -1331,7 +1331,7 @@ verify_chunks(LoaderState* stp)
static int
load_atom_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_atoms);
stp->num_atoms++;
@@ -1376,13 +1376,13 @@ load_atom_table(LoaderState* stp)
static int
load_import_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_imports);
stp->import = erts_alloc(ERTS_ALC_T_PREPARED_CODE,
stp->num_imports * sizeof(ImportEntry));
for (i = 0; i < stp->num_imports; i++) {
- int n;
+ unsigned int n;
Eterm mod;
Eterm func;
Uint arity;
@@ -1390,17 +1390,17 @@ load_import_table(LoaderState* stp)
GetInt(stp, 4, n);
if (n >= stp->num_atoms) {
- LoadError2(stp, "import entry %d: invalid atom number %d", i, n);
+ LoadError2(stp, "import entry %u: invalid atom number %u", i, n);
}
mod = stp->import[i].module = stp->atom[n];
GetInt(stp, 4, n);
if (n >= stp->num_atoms) {
- LoadError2(stp, "import entry %d: invalid atom number %d", i, n);
+ LoadError2(stp, "import entry %u: invalid atom number %u", i, n);
}
func = stp->import[i].function = stp->atom[n];
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "import entry %d: invalid arity %d", i, arity);
+ LoadError2(stp, "import entry %u: invalid arity %d", i, arity);
}
stp->import[i].arity = arity;
stp->import[i].patches = 0;
@@ -1428,12 +1428,12 @@ load_import_table(LoaderState* stp)
static int
read_export_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
BeamInstr* address;
GetInt(stp, 4, stp->num_exps);
if (stp->num_exps > stp->num_functions) {
- LoadError2(stp, "%d functions exported; only %d functions defined",
+ LoadError2(stp, "%u functions exported; only %u functions defined",
stp->num_exps, stp->num_functions);
}
stp->export
@@ -1451,16 +1451,16 @@ read_export_table(LoaderState* stp)
stp->export[i].function = func;
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "export table entry %d: absurdly high arity %d", i, arity);
+ LoadError2(stp, "export table entry %u: absurdly high arity %u", i, arity);
}
stp->export[i].arity = arity;
GetInt(stp, 4, n);
if (n >= stp->num_labels) {
- LoadError3(stp, "export table entry %d: invalid label %d (highest defined label is %d)", i, n, stp->num_labels);
+ LoadError3(stp, "export table entry %u: invalid label %u (highest defined label is %u)", i, n, stp->num_labels);
}
value = stp->labels[n].value;
if (value == 0) {
- LoadError2(stp, "export table entry %d: label %d not resolved", i, n);
+ LoadError2(stp, "export table entry %u: label %u not resolved", i, n);
}
stp->export[i].address = address = stp->codev + value;
@@ -1521,7 +1521,7 @@ is_bif(Eterm mod, Eterm func, unsigned arity)
static int
read_lambda_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_lambdas);
if (stp->num_lambdas > stp->lambdas_allocated) {
@@ -1541,12 +1541,12 @@ read_lambda_table(LoaderState* stp)
GetAtom(stp, n, stp->lambdas[i].function);
GetInt(stp, 4, arity);
if (arity > MAX_REG) {
- LoadError2(stp, "lambda entry %d: absurdly high arity %d", i, arity);
+ LoadError2(stp, "lambda entry %u: absurdly high arity %u", i, arity);
}
stp->lambdas[i].arity = arity;
GetInt(stp, 4, n);
if (n >= stp->num_labels) {
- LoadError3(stp, "lambda entry %d: invalid label %d (highest defined label is %d)",
+ LoadError3(stp, "lambda entry %u: invalid label %u (highest defined label is %u)",
i, n, stp->num_labels);
}
stp->lambdas[i].label = n;
@@ -1567,7 +1567,7 @@ read_lambda_table(LoaderState* stp)
static int
read_literal_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
uLongf uncompressed_sz;
byte* uncompressed = 0;
@@ -1589,7 +1589,7 @@ read_literal_table(LoaderState* stp)
}
for (i = 0; i < stp->num_literals; i++) {
- int sz;
+ Uint sz;
Sint heap_size;
byte* p;
Eterm val;
@@ -1598,7 +1598,7 @@ read_literal_table(LoaderState* stp)
GetInt(stp, 4, sz); /* Size of external term format. */
GetString(stp, p, sz);
if ((heap_size = erts_decode_ext_size(p, sz)) < 0) {
- LoadError1(stp, "literal %d: bad external format", i);
+ LoadError1(stp, "literal %u: bad external format", i);
}
if (heap_size > 0) {
@@ -1608,7 +1608,7 @@ read_literal_table(LoaderState* stp)
val = erts_decode_ext(&factory, &p, 0);
if (is_non_value(val)) {
- LoadError1(stp, "literal %d: bad external format", i);
+ LoadError1(stp, "literal %u: bad external format", i);
}
erts_factory_close(&factory);
stp->literals[i].heap_frags = factory.heap_frags;
@@ -1618,7 +1618,7 @@ read_literal_table(LoaderState* stp)
erts_factory_dummy_init(&factory);
val = erts_decode_ext(&factory, &p, 0);
if (is_non_value(val)) {
- LoadError1(stp, "literal %d: bad external format", i);
+ LoadError1(stp, "literal %u: bad external format", i);
}
ASSERT(is_immed(val));
stp->literals[i].heap_frags = NULL;
@@ -1641,9 +1641,9 @@ read_line_table(LoaderState* stp)
{
unsigned version;
ERTS_DECLARE_DUMMY(unsigned flags);
- int num_line_items;
+ unsigned int num_line_items;
BeamInstr* lp;
- int i;
+ unsigned int i;
BeamInstr fname_index;
BeamInstr tag;
@@ -1722,7 +1722,7 @@ read_line_table(LoaderState* stp)
}
} else if (tag == TAG_a) {
if (val > stp->num_fnames) {
- LoadError2(stp, "file index overflow (%d/%d)",
+ LoadError2(stp, "file index overflow (%u/%u)",
val, stp->num_fnames);
}
fname_index = val;
@@ -1758,9 +1758,9 @@ read_line_table(LoaderState* stp)
stp->num_line_instrs *
sizeof(LineInstr));
stp->current_li = 0;
- stp->func_line = (int *) erts_alloc(ERTS_ALC_T_PREPARED_CODE,
- stp->num_functions *
- sizeof(int));
+ stp->func_line = (unsigned int *) erts_alloc(ERTS_ALC_T_PREPARED_CODE,
+ stp->num_functions *
+ sizeof(int));
return 1;
@@ -1784,6 +1784,10 @@ read_code_header(LoaderState* stp)
*/
GetInt(stp, 4, head_size);
+ if (head_size > stp->file_left) {
+ LoadError2(stp, "invalid code header size %u; bytes left %u",
+ head_size, stp->file_left);
+ }
stp->code_start = stp->file_p + head_size;
stp->code_size = stp->file_left - head_size;
stp->file_left = head_size;
@@ -1888,7 +1892,7 @@ load_code(LoaderState* stp)
ci = stp->ci;
for (;;) {
- int new_op;
+ unsigned int new_op;
GenOp* tmp_op;
ASSERT(ci <= codev_size);
@@ -1896,10 +1900,10 @@ load_code(LoaderState* stp)
get_next_instr:
GetByte(stp, new_op);
if (new_op >= NUM_GENERIC_OPS) {
- LoadError1(stp, "invalid opcode %d", new_op);
+ LoadError1(stp, "invalid opcode %u", new_op);
}
if (gen_opc[new_op].name[0] == '\0') {
- LoadError1(stp, "invalid opcode %d", new_op);
+ LoadError1(stp, "invalid opcode %u", new_op);
}
@@ -2369,7 +2373,7 @@ load_code(LoaderState* stp)
VerifyTag(stp, tag, TAG_u);
last_label = tmp_op->a[arg].val;
if (!(0 < last_label && last_label < stp->num_labels)) {
- LoadError2(stp, "invalid label num %d (0 < label < %d)",
+ LoadError2(stp, "invalid label num %u (0 < label < %u)",
tmp_op->a[arg].val, stp->num_labels);
}
if (stp->labels[last_label].value != 0) {
@@ -2513,7 +2517,7 @@ load_code(LoaderState* stp)
{
Sint offset;
if (function_number >= stp->num_functions) {
- LoadError1(stp, "too many functions in module (header said %d)",
+ LoadError1(stp, "too many functions in module (header said %u)",
stp->num_functions);
}
@@ -2592,14 +2596,14 @@ load_code(LoaderState* stp)
if (stp->line_item) {
BeamInstr item = code[ci-1];
BeamInstr loc;
- int li;
+ unsigned int li;
if (item >= stp->num_line_items) {
- LoadError2(stp, "line instruction index overflow (%d/%d)",
+ LoadError2(stp, "line instruction index overflow (%u/%u)",
item, stp->num_line_items);
}
li = stp->current_li;
if (li >= stp->num_line_instrs) {
- LoadError2(stp, "line instruction table overflow (%d/%d)",
+ LoadError2(stp, "line instruction table overflow (%u/%u)",
li, stp->num_line_instrs);
}
loc = stp->line_item[item];
@@ -4560,8 +4564,8 @@ freeze_code(LoaderState* stp)
str_table = (byte *) (codev + stp->ci);
} else {
BeamCodeLineTab* const line_tab = (BeamCodeLineTab *) (codev+stp->ci);
- const int ftab_size = stp->num_functions;
- const int num_instrs = stp->current_li;
+ const unsigned int ftab_size = stp->num_functions;
+ const unsigned int num_instrs = stp->current_li;
const BeamInstr** const line_items =
(const BeamInstr**) &line_tab->func_tab[ftab_size + 1];
@@ -4721,7 +4725,7 @@ freeze_code(LoaderState* stp)
static void
final_touch(LoaderState* stp, struct erl_module_instance* inst_p)
{
- int i;
+ unsigned int i;
int on_load = stp->on_load;
unsigned catches;
Uint index;
@@ -5393,7 +5397,7 @@ new_genop(LoaderState* stp)
static int
new_label(LoaderState* stp)
{
- int num = stp->num_labels;
+ unsigned int num = stp->num_labels;
stp->num_labels++;
stp->labels = (Label *) erts_realloc(ERTS_ALC_T_PREPARED_CODE,
@@ -6013,11 +6017,11 @@ stub_copy_info(LoaderState* stp,
static int
stub_read_export_table(LoaderState* stp)
{
- int i;
+ unsigned int i;
GetInt(stp, 4, stp->num_exps);
if (stp->num_exps > stp->num_functions) {
- LoadError2(stp, "%d functions exported; only %d functions defined",
+ LoadError2(stp, "%u functions exported; only %u functions defined",
stp->num_exps, stp->num_functions);
}
stp->export
@@ -6031,7 +6035,7 @@ stub_read_export_table(LoaderState* stp)
GetAtom(stp, n, stp->export[i].function);
GetInt(stp, 4, n);
if (n > MAX_REG) {
- LoadError2(stp, "export table entry %d: absurdly high arity %d", i, n);
+ LoadError2(stp, "export table entry %u: absurdly high arity %u", i, n);
}
stp->export[i].arity = n;
GetInt(stp, 4, n); /* Ignore label */
@@ -6045,8 +6049,8 @@ stub_read_export_table(LoaderState* stp)
static void
stub_final_touch(LoaderState* stp, BeamInstr* fp)
{
- int i;
- int n = stp->num_exps;
+ unsigned int i;
+ unsigned int n = stp->num_exps;
Eterm mod = fp[2];
Eterm function = fp[3];
int arity = fp[4];
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 971052b947..6e8710eb8a 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -314,6 +314,7 @@ type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing
type THR_PRGR_IDATA LONG_LIVED SYSTEM thr_prgr_internal_data
type THR_PRGR_DATA LONG_LIVED SYSTEM thr_prgr_data
type T_THR_PRGR_DATA SHORT_LIVED SYSTEM temp_thr_prgr_data
+type RELEASE_LAREA SHORT_LIVED SYSTEM release_literal_area
+endif
#
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index ef18a508a5..830a06fb20 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -517,6 +517,8 @@ delay_garbage_collection(Process *p, ErlHeapFragment *live_hf_end, int need, int
erts_proc_sched_data((p))->virtual_reds += vreds;
}
+ ERTS_CHK_MBUF_SZ(p);
+
ASSERT(CONTEXT_REDS >= erts_proc_sched_data(p)->virtual_reds);
return reds_left;
}
@@ -527,6 +529,8 @@ young_gen_usage(Process *p)
Uint hsz;
Eterm *aheap;
+ ERTS_CHK_MBUF_SZ(p);
+
hsz = p->mbuf_sz;
if (p->flags & F_ON_HEAP_MSGQ) {
@@ -590,6 +594,8 @@ garbage_collect(Process* p, ErlHeapFragment *live_hf_end,
DTRACE_CHARBUF(pidbuf, DTRACE_TERM_BUF_SIZE);
#endif
+ ERTS_CHK_MBUF_SZ(p);
+
ASSERT(CONTEXT_REDS - ERTS_REDS_LEFT(p, fcalls)
>= erts_proc_sched_data(p)->virtual_reds);
diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c
index e9f0586edd..118adc0c1b 100644
--- a/erts/emulator/beam/erl_message.c
+++ b/erts/emulator/beam/erl_message.c
@@ -1845,3 +1845,20 @@ void erts_factory_undo(ErtsHeapFactory* factory)
factory->heap_frags = NULL;
#endif
}
+
+Uint
+erts_mbuf_size(Process *p)
+{
+ Uint sz = 0;
+ ErlHeapFragment* bp;
+ ErtsMessage* mp;
+
+ for (bp = p->mbuf; bp; bp = bp->next)
+ sz += bp->used_size;
+
+ for (mp = p->msg_frag; mp; mp = mp->next)
+ for (bp = erts_message_to_heap_frag(mp); bp; bp = bp->next)
+ sz += bp->used_size;
+
+ return sz;
+}
diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h
index 6df969367b..42ed14e69c 100644
--- a/erts/emulator/beam/erl_message.h
+++ b/erts/emulator/beam/erl_message.h
@@ -499,4 +499,15 @@ erts_msgq_replace_msg_ref(ErlMessageQueue *msgq, ErtsMessage *newp, ErtsMessage
#endif
+Uint erts_mbuf_size(Process *p);
+#if defined(DEBUG) || 0
+# define ERTS_CHK_MBUF_SZ(P) \
+ do { \
+ Uint actual_mbuf_sz__ = erts_mbuf_size((P)); \
+ ERTS_ASSERT((P)->mbuf_sz >= actual_mbuf_sz__); \
+ } while (0)
+#else
+# define ERTS_CHK_MBUF_SZ(P) ((void) 1)
+#endif
+
#endif
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index f572577bde..bbfc673318 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -156,7 +156,9 @@ static Eterm* alloc_heap_heavy(ErlNifEnv* env, size_t need, Eterm* hp)
HEAP_TOP(env->proc) = env->hp;
}
else {
- env->heap_frag->used_size = hp - env->heap_frag->mem;
+ Uint usz = env->hp - env->heap_frag->mem;
+ env->proc->mbuf_sz += usz - env->heap_frag->used_size;
+ env->heap_frag->used_size = usz;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
hp = erts_heap_alloc(env->proc, need, MIN_HEAP_FRAG_SZ);
@@ -308,11 +310,14 @@ static void full_flush_env(ErlNifEnv* env)
HEAP_TOP(c_p) = env->hp;
}
else {
+ Uint usz;
ASSERT(env->hp_end != HEAP_LIMIT(c_p));
ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
HEAP_TOP(c_p) = HEAP_TOP(env->proc);
- env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ usz = env->hp - env->heap_frag->mem;
+ env->proc->mbuf_sz += usz - env->heap_frag->used_size;
+ env->heap_frag->used_size = usz;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
@@ -394,9 +399,12 @@ static void flush_env(ErlNifEnv* env)
HEAP_TOP(env->proc) = env->hp;
}
else {
+ Uint usz;
ASSERT(env->hp_end != HEAP_LIMIT(env->proc));
ASSERT(env->hp_end - env->hp <= env->heap_frag->alloc_size);
- env->heap_frag->used_size = env->hp - env->heap_frag->mem;
+ usz = env->hp - env->heap_frag->mem;
+ env->proc->mbuf_sz += usz - env->heap_frag->used_size;
+ env->heap_frag->used_size = usz;
ASSERT(env->heap_frag->used_size <= env->heap_frag->alloc_size);
}
}
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 91eb82af7d..d3526f2d5c 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -9406,6 +9406,14 @@ erts_set_process_priority(Process *p, Eterm value)
}
}
+#ifdef __WIN32__
+Sint64
+erts_time2reds(ErtsMonotonicTime start, ErtsMonotonicTime end)
+{
+ return ERTS_TIME2REDS_IMPL__(start, end);
+}
+#endif
+
static int
scheduler_gc_proc(Process *c_p, int reds_left)
{
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index f1788c3f71..3347a7a60e 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -1328,10 +1328,13 @@ ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp);
ERTS_GLB_INLINE void erts_heap_frag_shrink(Process* p, Eterm* hp)
{
ErlHeapFragment* hf = MBUF(p);
+ Uint sz;
ASSERT(hf!=NULL && (hp - hf->mem < hf->alloc_size));
- hf->used_size = hp - hf->mem;
+ sz = hp - hf->mem;
+ p->mbuf_sz -= hf->used_size - sz;
+ hf->used_size = sz;
}
#endif /* inline */
@@ -1549,9 +1552,9 @@ extern int erts_system_profile_ts_type;
#define ERTS_SCHEDULER_IS_DIRTY(ESDP) \
((ESDP)->dirty_no.s.num != 0)
#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) \
- ((ESDP)->dirty_no.s.type == 0)
+ (ERTS_SCHEDULER_IS_DIRTY((ESDP)) & ((ESDP)->dirty_no.s.type == 0))
#define ERTS_SCHEDULER_IS_DIRTY_IO(ESDP) \
- ((ESDP)->dirty_no.s.type == 1)
+ (ERTS_SCHEDULER_IS_DIRTY((ESDP)) & ((ESDP)->dirty_no.s.type == 1))
#else
#define ERTS_SCHEDULER_IS_DIRTY(ESDP) 0
#define ERTS_SCHEDULER_IS_DIRTY_CPU(ESDP) 0
@@ -2473,6 +2476,35 @@ erts_get_atom_cache_map(Process *c_p)
}
#endif
+#ifdef __WIN32__
+/*
+ * Don't want erts_time2reds() inlined in beam_emu.c on windows since
+ * it is compiled with gcc which fails on it. Implementation is in
+ * erl_process.c on windows.
+ */
+# define ERTS_TIME2REDS_IMPL__ erts_time2reds__
+#else
+# define ERTS_TIME2REDS_IMPL__ erts_time2reds
+#endif
+
+ERTS_GLB_INLINE Sint64 ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start,
+ ErtsMonotonicTime end);
+
+#if ERTS_GLB_INLINE_INCL_FUNC_DEF
+ERTS_GLB_INLINE Sint64
+ERTS_TIME2REDS_IMPL__(ErtsMonotonicTime start, ErtsMonotonicTime end)
+{
+ ErtsMonotonicTime time = end - start;
+ ASSERT(time >= 0);
+ time = ERTS_MONOTONIC_TO_USEC(time);
+ if (time == 0)
+ return (Sint64) 1; /* At least one reduction */
+ /* Currently two reductions per micro second */
+ time *= (CONTEXT_REDS-1)/1000 + 1;
+ return (Sint64) time;
+}
+#endif
+
Process *erts_pid2proc_suspend(Process *,
ErtsProcLocks,
Eterm,
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index 9e37106b88..6aa2a7500f 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -2133,22 +2133,26 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto
/* Convert to common user specified time units */
switch (term) {
+ case am_second:
case am_seconds:
case make_small(1):
result = ERTS_MONOTONIC_TO_SEC(val) + muloff*ERTS_MONOTONIC_OFFSET_SEC;
ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
break;
+ case am_millisecond:
case am_milli_seconds:
case make_small(1000):
result = ERTS_MONOTONIC_TO_MSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_MSEC;
ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
break;
+ case am_microsecond:
case am_micro_seconds:
case make_small(1000*1000):
result = ERTS_MONOTONIC_TO_USEC(val) + muloff*ERTS_MONOTONIC_OFFSET_USEC;
ERTS_BIF_PREP_RET(ret, make_time_val(c_p, result));
break;
#ifdef ARCH_64
+ case am_nanosecond:
case am_nano_seconds:
case make_small(1000*1000*1000):
result = ERTS_MONOTONIC_TO_NSEC(val) + muloff*ERTS_MONOTONIC_OFFSET_NSEC;
@@ -2159,7 +2163,7 @@ time_unit_conversion(Process *c_p, Eterm term, ErtsMonotonicTime val, ErtsMonoto
Eterm value, native_res;
#ifndef ARCH_64
Sint user_res;
- if (term == am_nano_seconds)
+ if (term == am_nanosecond || term == am_nano_seconds)
goto to_nano_seconds;
if (term_to_Sint(term, &user_res)) {
if (user_res == 1000*1000*1000) {
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 0fd9ab5e58..586c01b15b 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1012,7 +1012,9 @@ typedef struct ErtsLiteralArea_ {
#define ERTS_LITERAL_AREA_ALLOC_SIZE(N) \
(sizeof(ErtsLiteralArea) + sizeof(Eterm)*((N) - 1))
-extern ErtsLiteralArea *erts_copy_literal_area;
+extern erts_smp_atomic_t erts_copy_literal_area__;
+#define ERTS_COPY_LITERAL_AREA() \
+ ((ErtsLiteralArea *) erts_smp_atomic_read_nob(&erts_copy_literal_area__))
extern Process *erts_literal_area_collector;
#ifdef ERTS_DIRTY_SCHEDULERS
extern Process *erts_dirty_process_code_checker;
@@ -1101,7 +1103,7 @@ typedef struct {
#define INITIALIZE_SHCOPY(info) \
do { \
- ErtsLiteralArea *larea__ = erts_copy_literal_area; \
+ ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \
info.queue_start = info.queue_default; \
info.bitstore_start = info.bitstore_default; \
info.shtable_start = info.shtable_default; \
@@ -1137,7 +1139,7 @@ typedef struct {
#define INITIALIZE_LITERAL_PURGE_AREA(Area) \
do { \
- ErtsLiteralArea *larea__ = erts_copy_literal_area; \
+ ErtsLiteralArea *larea__ = ERTS_COPY_LITERAL_AREA(); \
if (larea__) { \
(Area).lit_purge_ptr = &larea__->start[0]; \
(Area).lit_purge_sz = larea__->end - (Area).lit_purge_ptr; \
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index 85647b8500..6786657faf 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -102,6 +102,7 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
if (bp != NULL && need <= (bp->alloc_size - bp->used_size)) {
Eterm* ret = bp->mem + bp->used_size;
bp->used_size += need;
+ p->mbuf_sz += need;
return ret;
}
#ifdef DEBUG
@@ -124,7 +125,7 @@ erts_heap_alloc(Process* p, Uint need, Uint xtra)
MBUF(p) = bp;
bp->alloc_size = n;
bp->used_size = need;
- MBUF_SIZE(p) += n;
+ MBUF_SIZE(p) += need;
bp->off_heap.first = NULL;
bp->off_heap.overhead = 0;
return bp->mem;
diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c
index e394d84f73..b8a28bcc18 100644
--- a/erts/emulator/sys/common/erl_poll.c
+++ b/erts/emulator/sys/common/erl_poll.c
@@ -75,6 +75,7 @@
#include "erl_driver.h"
#include "erl_alloc.h"
#include "erl_msacc.h"
+#include "erl_misc_utils.h"
#if !defined(ERTS_POLL_USE_EPOLL) \
&& !defined(ERTS_POLL_USE_DEVPOLL) \
@@ -2132,16 +2133,19 @@ get_timeout(ErtsPollSet ps,
if (timeout > (ErtsMonotonicTime) INT_MAX)
timeout = (ErtsMonotonicTime) INT_MAX;
save_timeout_time += ERTS_MSEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000);
break;
case 1000000:
/* Round up to nearest even micro second */
timeout = ERTS_MONOTONIC_TO_USEC(diff_time - 1) + 1;
save_timeout_time += ERTS_USEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000);
break;
case 1000000000:
/* Round up to nearest even nano second */
timeout = ERTS_MONOTONIC_TO_NSEC(diff_time - 1) + 1;
save_timeout_time += ERTS_NSEC_TO_MONOTONIC(timeout);
+ timeout -= ERTS_PREMATURE_TIMEOUT(timeout, 1000*1000*1000);
break;
default:
ERTS_INTERNAL_ERROR("Invalid resolution");
@@ -2452,7 +2456,15 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps,
}
#endif
- res = check_fd_events(ps, to, no_fds);
+ while (1) {
+ res = check_fd_events(ps, to, no_fds);
+ if (res != 0)
+ break;
+ if (to == ERTS_POLL_NO_TIMEOUT)
+ break;
+ if (erts_get_monotonic_time(NULL) >= timeout_time)
+ break;
+ }
woke_up(ps);
diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl
index 4f20ad3656..b1f7e06bf5 100644
--- a/erts/emulator/test/after_SUITE.erl
+++ b/erts/emulator/test/after_SUITE.erl
@@ -223,7 +223,7 @@ recv_after_32bit(_, _) ->
blaster() ->
receive
{go, TimeoutTime} ->
- Tmo = TimeoutTime - erlang:monotonic_time(milli_seconds),
+ Tmo = TimeoutTime - erlang:monotonic_time(millisecond),
receive after Tmo -> ok end
end.
@@ -234,7 +234,7 @@ spawn_blasters(N) ->
receive_after_blast(Config) when is_list(Config) ->
PMs = spawn_blasters(10000),
- TimeoutTime = erlang:monotonic_time(milli_seconds) + 5000,
+ TimeoutTime = erlang:monotonic_time(millisecond) + 5000,
lists:foreach(fun ({P, _}) -> P ! {go, TimeoutTime} end, PMs),
lists:foreach(fun ({P, M}) ->
receive
diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl
index 84cf4921d3..3a721095e2 100644
--- a/erts/emulator/test/alloc_SUITE.erl
+++ b/erts/emulator/test/alloc_SUITE.erl
@@ -342,7 +342,7 @@ start_node_1(Config, Opts) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl
index bb0632ae08..7094cee992 100644
--- a/erts/emulator/test/busy_port_SUITE.erl
+++ b/erts/emulator/test/busy_port_SUITE.erl
@@ -469,12 +469,12 @@ hs_busy_pcmd(Prt, Opts, StartFun, EndFun) ->
P = spawn_link(fun () ->
erlang:yield(),
Tester ! {self(), doing_port_command},
- Start = erlang:monotonic_time(micro_seconds),
+ Start = erlang:monotonic_time(microsecond),
Res = try {return,
port_command(Prt, [], Opts)}
catch Exception:Error -> {Exception, Error}
end,
- End = erlang:monotonic_time(micro_seconds),
+ End = erlang:monotonic_time(microsecond),
Time = round((End - Start)/1000),
Tester ! {self(), port_command_result, Res, Time}
end),
@@ -717,7 +717,7 @@ run_command(_M,spawn,{Args,Opts}) ->
run_command(M,spawn,Args) ->
run_command(M,spawn,{Args,[]});
run_command(Mod,Func,Args) ->
- erlang:display({{Mod,Func,Args}, erlang:system_time(micro_seconds)}),
+ erlang:display({{Mod,Func,Args}, erlang:system_time(microsecond)}),
apply(Mod,Func,Args).
validate_scenario(Data,[{print,Var}|T]) ->
diff --git a/erts/emulator/test/dirty_nif_SUITE.erl b/erts/emulator/test/dirty_nif_SUITE.erl
index 653b96557e..658bdc41b6 100644
--- a/erts/emulator/test/dirty_nif_SUITE.erl
+++ b/erts/emulator/test/dirty_nif_SUITE.erl
@@ -148,9 +148,9 @@ dirty_scheduler_exit(Config) when is_list(Config) ->
[ok] = mcall(Node,
[fun() ->
ok = erlang:load_nif(NifLib, []),
- Start = erlang:monotonic_time(milli_seconds),
+ Start = erlang:monotonic_time(millisecond),
ok = test_dirty_scheduler_exit(),
- End = erlang:monotonic_time(milli_seconds),
+ End = erlang:monotonic_time(millisecond),
io:format("Time=~p ms~n", [End-Start]),
ok
end]),
@@ -233,7 +233,11 @@ dirty_call_while_terminated(Config) when is_list(Config) ->
process_info(self(),
binary))),
process_flag(trap_exit, OT),
- ok.
+ try
+ blipp:blupp(Bin)
+ catch
+ _ : _ -> ok
+ end.
dirty_heap_access(Config) when is_list(Config) ->
{ok, Node} = start_node(Config),
@@ -500,7 +504,7 @@ start_node(Config, Args) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 159fbc806b..6994bfef83 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -1950,7 +1950,7 @@ port_please(_Name, _Ip) ->
%%% Utilities
timestamp() ->
- erlang:monotonic_time(milli_seconds).
+ erlang:monotonic_time(millisecond).
start_node(X) ->
start_node(X, [], []).
@@ -1974,7 +1974,7 @@ start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive])))),
start_node(Name, Args, Rel).
@@ -2091,7 +2091,7 @@ node_monitor(Master) ->
Master ! {nodeup, node(), Node}
end,
Nodes0),
- io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Nodes0]),
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Nodes0]),
node_monitor_loop(Master);
false ->
net_kernel:monitor_nodes(false, Opts),
@@ -2112,7 +2112,7 @@ node_monitor_loop(Master) ->
receive
{nodeup, Node, _InfoList} = Msg ->
Master ! {nodeup, node(), Node},
- io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Msg]),
node_monitor_loop(Master);
{nodedown, Node, InfoList} = Msg ->
Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of
@@ -2120,7 +2120,7 @@ node_monitor_loop(Master) ->
_ -> undefined
end,
Master ! {nodedown, node(), Node, Reason},
- io:format("~p ~p: ~p~n", [node(), erlang:system_time(micro_seconds), Msg]),
+ io:format("~p ~p: ~p~n", [node(), erlang:system_time(microsecond), Msg]),
node_monitor_loop(Master)
end.
diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl
index f134a197aa..1df72193a6 100644
--- a/erts/emulator/test/driver_SUITE.erl
+++ b/erts/emulator/test/driver_SUITE.erl
@@ -114,7 +114,7 @@
-define(MAX_DATA_SIZE, 16384).
% This is the allowed delay when testing the driver timer functionality
--define(delay, 100).
+-define(delay, 400).
-define(heap_binary_size, 64).
@@ -401,7 +401,7 @@ try_timeouts(Port, Timeout) ->
true ->
try_timeouts(Port, Timeout div 2)
end
- after Timeout + ?delay ->
+ after Timeout + 100*?delay ->
ct:fail("driver failed to timeout")
end.
@@ -437,7 +437,7 @@ try_cancel(Port, Timeout) ->
Timeout == 0 -> ok;
true -> try_cancel(Port, Timeout div 2)
end
- after ?delay ->
+ after 100*?delay ->
ct:fail("No message from driver")
end
end.
@@ -505,7 +505,7 @@ try_change_timer(Port, Timeout) ->
true ->
try_timeouts(Port, Timeout div 2)
end
- after Timeout + ?delay ->
+ after Timeout + 100*?delay ->
ct:fail("driver failed to timeout")
end.
@@ -2427,7 +2427,7 @@ erl_millisecs() ->
erl_millisecs(erlang:monotonic_time()).
erl_millisecs(MonotonicTime) ->
- (1000*MonotonicTime)/erlang:convert_time_unit(1,seconds,native).
+ (1000*MonotonicTime)/erlang:convert_time_unit(1,second,native).
%% Start/stop drivers.
start_driver(Config, Name, Binary) ->
@@ -2481,7 +2481,7 @@ start_node(Config) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index 93d2065ba3..89e1aefb50 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -1011,7 +1011,7 @@ get_names(N, T, Acc) ->
++ "-"
++ atom_to_list(T)
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))) | Acc]).
diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl
index 1180a45585..3ce849b88e 100644
--- a/erts/emulator/test/estone_SUITE.erl
+++ b/erts/emulator/test/estone_SUITE.erl
@@ -364,7 +364,7 @@ monotonic_time() ->
try erlang:monotonic_time() catch error:undef -> erlang:now() end.
subtr(Before, After) when is_integer(Before), is_integer(After) ->
- erlang:convert_time_unit(After-Before, native, micro_seconds);
+ erlang:convert_time_unit(After-Before, native, microsecond);
subtr({_,_,_}=Before, {_,_,_}=After) ->
timer:now_diff(After, Before).
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl
index e85addae3a..36b1f9179f 100644
--- a/erts/emulator/test/float_SUITE.erl
+++ b/erts/emulator/test/float_SUITE.erl
@@ -276,7 +276,7 @@ start_node(Config) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, "-pa "++Pa}]).
diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl
index 7c055a31f9..c9a380a229 100644
--- a/erts/emulator/test/long_timers_test.erl
+++ b/erts/emulator/test/long_timers_test.erl
@@ -27,11 +27,16 @@
%%% Created : 21 Aug 2006 by Rickard Green <[email protected]>
%%%-------------------------------------------------------------------
+-define(HIGH_CPU_INFO, "Ignored due to high CPU utilization.").
+-define(MISSING_CPU_INFO, "Ignored due to missing CPU utilization information.").
-define(MAX_TIMEOUT, 60). % Minutes
--define(MAX_LATE_MS, 15*1000). % Milliseconds
+-define(MAX_LATE_MS, 1000). % Milliseconds
-define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___').
+-define(HIGH_UTIL, 96.0).
+-define(UTIL_INTERVAL, 10000).
+
-define(DRV_NAME, timer_driver).
% First byte in communication with the timer driver
@@ -72,52 +77,149 @@ check_result() ->
receive
{'DOWN', Mon, process, _, Reason} ->
{?REG_NAME, 'DOWN', Reason};
- {result, ?REG_NAME, TORs, Start, End} ->
+ {result, ?REG_NAME, TORs, Start, End, UtilData} ->
erlang:demonitor(Mon),
receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end,
stop_node(Node),
- check(TORs, ms((End - Start) - max_late()), ok)
+ Res = check(TORs, Start, End, UtilData, ms((End - Start) - max_late()), ok),
+ io:format("Start = ~p~n End = ~p~n UtilData = ~p~n", [Start, End, UtilData]),
+ Res
end.
+res(New, Old) when New == failed; Old == failed ->
+ failed;
+res(New, Old) when New == missing_cpu_info; Old == missing_cpu_info ->
+ missing_cpu_info;
+res(New, Old) when New == high_cpu; Old == high_cpu ->
+ high_cpu;
+res(New, _Old) ->
+ New.
+
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = undefined} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
- _Ok) when Timeout < NeedRes ->
- io:format("~p timeout = ~p ms failed! No timeout.~n",
- [Type, Timeout]),
- check(TORs, NeedRes, failed);
+ Ok) when Timeout < NeedRes ->
+ {NewOk, HCPU} = case had_high_cpu_util(Start,
+ Timeout,
+ End - Timeout*1000,
+ UtilData) of
+ yes -> {res(high_cpu, Ok), ?HIGH_CPU_INFO};
+ no -> {res(failed, Ok), ""};
+ missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
+ end,
+ io:format("~p timeout = ~p ms FAILED! No timeout. ~s~n",
+ [Type, Timeout, HCPU]),
+ check(TORs, Start, End, UtilData, NeedRes, NewOk);
check([#timeout_rec{timeout_diff = undefined} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
Ok) ->
- check(TORs, NeedRes, Ok);
+ check(TORs, Start, End, UtilData, NeedRes, Ok);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = {error, Reason}} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
_Ok) ->
- io:format("~p timeout = ~p ms failed! exit reason ~p~n",
+ io:format("~p timeout = ~p ms FAILED! exit reason ~p~n",
[Type, Timeout, Reason]),
- check(TORs, NeedRes, failed);
+ check(TORs, Start, End, UtilData, NeedRes, failed);
check([#timeout_rec{timeout = Timeout,
type = Type,
timeout_diff = TimeoutDiff} | TORs],
+ Start,
+ End,
+ UtilData,
NeedRes,
Ok) ->
- {NewOk, SuccessStr} = case ((0 =< TimeoutDiff)
- andalso (TimeoutDiff =< max_late())) of
- true -> {Ok, "succeeded"};
- false -> {failed, "FAILED"}
+ {NewOk, SuccessStr, HCPU} = case {(0 =< TimeoutDiff),
+ (TimeoutDiff =< max_late())} of
+ {true, true} ->
+ {res(ok, Ok), "succeeded", ""};
+ {false, _} ->
+ {res(failed, Ok), "FAILED", ""};
+ _ ->
+ case had_high_cpu_util(Start,
+ Timeout,
+ TimeoutDiff,
+ UtilData) of
+ yes -> {res(high_cpu, Ok), "FAILED", ?HIGH_CPU_INFO};
+ no -> {res(failed, Ok), "FAILED", ""};
+ missing -> {res(missing_cpu_info, Ok), "FAILED", ?MISSING_CPU_INFO}
+ end
end,
- io:format("~s timeout = ~s ms ~s! timeout diff = ~s.~n",
+ io:format("~s timeout = ~s ms ~s! timeout diff = ~s. ~s~n",
[type_str(Type),
time_str(Timeout),
SuccessStr,
- time_str(TimeoutDiff, erlang:convert_time_unit(1, seconds, native))]),
- check(TORs, NeedRes, NewOk);
-check([], _NeedRes, Ok) ->
+ time_str(TimeoutDiff, 1000000),
+ HCPU]),
+ check(TORs, Start, End, UtilData, NeedRes, NewOk);
+check([],_Start,_End,_UtilData,_NeedRes, Ok) ->
Ok.
+% TargetTimeout in ms, other in us.
+had_high_cpu_util(StartTime,
+ TargetTimeout,
+ TimeoutDiff,
+ UtilData) ->
+ TargetTo = StartTime + TargetTimeout*1000,
+ ActTo = TargetTo + TimeoutDiff,
+ hcpu(ActTo, TargetTo, UtilData).
+
+hcpu(_ActTo, _TargetTo, [{UT, 0} | _] = UD) ->
+ missing; %% Util is the integer zero when not supported...
+%% UT2 =:= UT1
+hcpu(ActTo, TargetTo, [{UT, _}, {UT, _} | _] = UD) ->
+ hcpu(ActTo, TargetTo, tl(UD));
+%% UT2 > UT1 > ActTo > TargetTo
+hcpu(ActTo, TargetTo, [{_UT2, _}, {UT1, _} | _] = UD) when UT1 > ActTo ->
+ hcpu(ActTo, TargetTo, tl(UD));
+%% UT2 >= ActTo > TargetTo >= UT1
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _]) when UT2 >= ActTo,
+ TargetTo >= UT1 ->
+ case U >= (((ActTo - TargetTo) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> yes;
+ false -> no
+ end;
+%% UT2 >= ActTo >= UT1 > TargetTo
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _] = UD) when UT2 >= ActTo,
+ ActTo >= UT1,
+ UT1 > TargetTo ->
+ case U >= (((ActTo - UT1) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> hcpu(ActTo, TargetTo, tl(UD));
+ false -> no
+ end;
+%% ActTo > UT2 >= TargetTo >= UT1
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _]) when ActTo > UT2,
+ TargetTo >= UT1 ->
+ case U >= (((UT2 - TargetTo) / (UT2 - UT1))
+ * (?HIGH_UTIL/100.0)) of
+ true -> yes;
+ false -> no
+ end;
+%% ActTo > UT2 > UT1 > TargetTo
+hcpu(ActTo, TargetTo,
+ [{UT2, U}, {UT1, _} | _] = UD) when ActTo > UT2,
+ UT1 > TargetTo ->
+ case U >= ?HIGH_UTIL of
+ true -> hcpu(ActTo, TargetTo, tl(UD));
+ false -> no
+ end.
+
type_str(receive_after) -> "receive ... after";
type_str(bif_timer) -> "BIF timer";
type_str(driver) -> "driver".
@@ -142,24 +244,24 @@ unit_str(Res) -> Res.
to_diff(Timeout, Start, Stop) ->
%% 'Timeout' in milli seconds
- %% 'Start', 'Stop', and result in native unit
- (Stop - Start) - erlang:convert_time_unit(Timeout, milli_seconds, native).
+ %% 'Start', 'Stop', and result in micro seconds
+ (Stop - Start) - Timeout*1000.
ms(Time) ->
- erlang:convert_time_unit(Time, native, milli_seconds).
+ erlang:convert_time_unit(Time, microsecond, millisecond).
max_late() ->
- erlang:convert_time_unit(?MAX_LATE_MS, milli_seconds, native).
+ erlang:convert_time_unit(?MAX_LATE_MS, millisecond, microsecond).
receive_after(Timeout) ->
- Start = erlang:monotonic_time(),
+ Start = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
type = receive_after,
timeout = Timeout}
after Timeout ->
- Stop = erlang:monotonic_time(),
+ Stop = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
@@ -174,7 +276,7 @@ receive_after(Timeout) ->
driver(Timeout) ->
Port = open_port({spawn, ?DRV_NAME},[]),
link(Port),
- Start = erlang:monotonic_time(),
+ Start = erlang:monotonic_time(microsecond),
erlang:port_command(Port, <<?START_TIMER, Timeout:32>>),
receive
{get_result, ?REG_NAME} ->
@@ -182,7 +284,7 @@ driver(Timeout) ->
type = driver,
timeout = Timeout};
{Port,{data,[?TIMER]}} ->
- Stop = erlang:monotonic_time(),
+ Stop = erlang:monotonic_time(microsecond),
unlink(Port),
true = erlang:port_close(Port),
receive
@@ -197,7 +299,7 @@ driver(Timeout) ->
end.
bif_timer(Timeout) ->
- Start = erlang:monotonic_time(),
+ Start = erlang:monotonic_time(microsecond),
Tmr = erlang:start_timer(Timeout, self(), ok),
receive
{get_result, ?REG_NAME} ->
@@ -205,7 +307,7 @@ bif_timer(Timeout) ->
type = bif_timer,
timeout = Timeout};
{timeout, Tmr, ok} ->
- Stop = erlang:monotonic_time(),
+ Stop = erlang:monotonic_time(microsecond),
receive
{get_result, ?REG_NAME} ->
?REG_NAME ! #timeout_rec{pid = self(),
@@ -218,13 +320,22 @@ bif_timer(Timeout) ->
end.
test(Starter, DrvDir, StartDone) ->
+ process_flag(priority, high),
erl_ddll:start(),
ok = load_driver(DrvDir, ?DRV_NAME),
process_flag(trap_exit, true),
register(?REG_NAME, self()),
{group_leader, GL} = process_info(whereis(net_kernel),group_leader),
group_leader(GL, self()),
- Start = erlang:monotonic_time(),
+ try
+ application:start(sasl),
+ application:start(os_mon)
+ catch
+ _ : _ ->
+ ok
+ end,
+ UtilData = new_util(),
+ Start = erlang:monotonic_time(microsecond),
TORs = lists:map(fun (Min) ->
TO = Min*60*1000,
[#timeout_rec{pid = spawn_opt(
@@ -252,16 +363,27 @@ test(Starter, DrvDir, StartDone) ->
lists:seq(1, ?MAX_TIMEOUT)),
FlatTORs = lists:flatten(TORs),
Starter ! StartDone,
- test_loop(FlatTORs, Start).
+ test_loop(FlatTORs, Start, UtilData).
+
+new_util() ->
+ new_util([]).
+
+new_util(UtilData) ->
+ Util = cpu_sup:util(),
+ Time = erlang:monotonic_time(microsecond),
+ [{Time, Util} | UtilData].
-test_loop(TORs, Start) ->
+test_loop(TORs, Start, UtilData) ->
receive
{get_result, ?REG_NAME, Pid} ->
- End = erlang:monotonic_time(),
- Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End},
+ End = erlang:monotonic_time(microsecond),
+ EndUtilData = new_util(UtilData),
+ Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End, EndUtilData},
erl_ddll:unload_driver(?DRV_NAME),
erl_ddll:stop(),
exit(bye)
+ after ?UTIL_INTERVAL ->
+ test_loop(TORs, Start, new_util(UtilData))
end.
get_test_results(TORs) ->
diff --git a/erts/emulator/test/message_queue_data_SUITE.erl b/erts/emulator/test/message_queue_data_SUITE.erl
index 44e77dfad0..e084b9482d 100644
--- a/erts/emulator/test/message_queue_data_SUITE.erl
+++ b/erts/emulator/test/message_queue_data_SUITE.erl
@@ -200,7 +200,7 @@ start_node(Config, Opts) when is_list(Config), is_list(Opts) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, Opts++" -pa "++Pa}]).
diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl
index 90d2bd8c5d..827ed817cc 100644
--- a/erts/emulator/test/monitor_SUITE.erl
+++ b/erts/emulator/test/monitor_SUITE.erl
@@ -697,7 +697,7 @@ mixer(Config) when is_list(Config) ->
named_down(Config) when is_list(Config) ->
Name = list_to_atom(atom_to_list(?MODULE)
++ "-named_down-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-" ++ integer_to_list(erlang:unique_integer([positive]))),
Prio = process_flag(priority,high),
%% Spawn a bunch of high prio cpu bound processes to prevent
diff --git a/erts/emulator/test/mtx_SUITE.erl b/erts/emulator/test/mtx_SUITE.erl
index 1493e52655..12928ed6d8 100644
--- a/erts/emulator/test/mtx_SUITE.erl
+++ b/erts/emulator/test/mtx_SUITE.erl
@@ -443,7 +443,7 @@ hammer_ets_rwlock_test(XOpts, UW, C, N, NP, SC) ->
{'DOWN', M, process, P, _} -> ok
end
end, Ps),
- Res = (Stop-Start)/erlang:convert_time_unit(1,seconds,native),
+ Res = (Stop-Start)/erlang:convert_time_unit(1,second,native),
Caller ! {?MODULE, self(), Res}
end,
TP = spawn_link(T),
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index a0e9f1bad6..8df2733fac 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1443,6 +1443,17 @@ otp_9828_loop(Bin, Val) ->
consume_timeslice(Config) when is_list(Config) ->
+ case {erlang:system_info(debug_compiled),
+ erlang:system_info(lock_checking)} of
+ {false, false} ->
+ consume_timeslice_test(Config);
+ {false, true} ->
+ {skipped, "Lock checking enabled"};
+ _ ->
+ {skipped, "Debug compiled"}
+ end.
+
+consume_timeslice_test(Config) when is_list(Config) ->
CONTEXT_REDS = 2000,
Me = self(),
Go = make_ref(),
@@ -1692,7 +1703,7 @@ nif_raise_exceptions(NifFunc) ->
end, ok, ExcTerms).
-define(ERL_NIF_TIME_ERROR, -9223372036854775808).
--define(TIME_UNITS, [seconds, milli_seconds, micro_seconds, nano_seconds]).
+-define(TIME_UNITS, [second, millisecond, microsecond, nanosecond]).
nif_monotonic_time(Config) ->
?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit),
@@ -1758,8 +1769,8 @@ chk_toffs([TU|TUs]) ->
chk_toffs(TUs).
nif_convert_time_unit(Config) ->
- ?ERL_NIF_TIME_ERROR = convert_time_unit(0, seconds, invalid_time_unit),
- ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, seconds),
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, second, invalid_time_unit),
+ ?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, second),
?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit),
lists:foreach(fun (Offset) ->
lists:foreach(fun (Diff) ->
@@ -1808,7 +1819,7 @@ nif_convert_time_unit(Config) ->
ctu_loop(0) ->
ok;
ctu_loop(N) ->
- chk_ctu(erlang:monotonic_time(nano_seconds)),
+ chk_ctu(erlang:monotonic_time(nanosecond)),
ctu_loop(N-1).
chk_ctu(Time) ->
@@ -1823,7 +1834,7 @@ chk_ctu(Time, [FromTU|FromTUs]) ->
chk_ctu(_Time, _FromTU, []) ->
ok;
chk_ctu(Time, FromTU, [ToTU|ToTUs]) ->
- T = erlang:convert_time_unit(Time, nano_seconds, FromTU),
+ T = erlang:convert_time_unit(Time, nanosecond, FromTU),
TE = erlang:convert_time_unit(T, FromTU, ToTU),
TN = convert_time_unit(T, FromTU, ToTU),
case TE =:= TN of
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 13846244d4..f2b1ef9d24 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -38,10 +38,10 @@ static ERL_NIF_TERM atom_self;
static ERL_NIF_TERM atom_ok;
static ERL_NIF_TERM atom_join;
static ERL_NIF_TERM atom_binary_resource_type;
-static ERL_NIF_TERM atom_seconds;
-static ERL_NIF_TERM atom_milli_seconds;
-static ERL_NIF_TERM atom_micro_seconds;
-static ERL_NIF_TERM atom_nano_seconds;
+static ERL_NIF_TERM atom_second;
+static ERL_NIF_TERM atom_millisecond;
+static ERL_NIF_TERM atom_microsecond;
+static ERL_NIF_TERM atom_nanosecond;
typedef struct
@@ -147,10 +147,10 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
atom_ok = enif_make_atom(env,"ok");
atom_join = enif_make_atom(env,"join");
atom_binary_resource_type = enif_make_atom(env,"binary_resource_type");
- atom_seconds = enif_make_atom(env,"seconds");
- atom_milli_seconds = enif_make_atom(env,"milli_seconds");
- atom_micro_seconds = enif_make_atom(env,"micro_seconds");
- atom_nano_seconds = enif_make_atom(env,"nano_seconds");
+ atom_second = enif_make_atom(env,"second");
+ atom_millisecond = enif_make_atom(env,"millisecond");
+ atom_microsecond = enif_make_atom(env,"microsecond");
+ atom_nanosecond = enif_make_atom(env,"nanosecond");
*priv_data = data;
return 0;
@@ -1808,13 +1808,13 @@ static ERL_NIF_TERM monotonic_time(ErlNifEnv* env, int argc, const ERL_NIF_TERM
if (argc != 1)
return atom_false;
- if (enif_compare(argv[0], atom_seconds) == 0)
+ if (enif_compare(argv[0], atom_second) == 0)
time_unit = ERL_NIF_SEC;
- else if (enif_compare(argv[0], atom_milli_seconds) == 0)
+ else if (enif_compare(argv[0], atom_millisecond) == 0)
time_unit = ERL_NIF_MSEC;
- else if (enif_compare(argv[0], atom_micro_seconds) == 0)
+ else if (enif_compare(argv[0], atom_microsecond) == 0)
time_unit = ERL_NIF_USEC;
- else if (enif_compare(argv[0], atom_nano_seconds) == 0)
+ else if (enif_compare(argv[0], atom_nanosecond) == 0)
time_unit = ERL_NIF_NSEC;
else
time_unit = 4711; /* invalid time unit */
@@ -1829,13 +1829,13 @@ static ERL_NIF_TERM time_offset(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
if (argc != 1)
return atom_false;
- if (enif_compare(argv[0], atom_seconds) == 0)
+ if (enif_compare(argv[0], atom_second) == 0)
time_unit = ERL_NIF_SEC;
- else if (enif_compare(argv[0], atom_milli_seconds) == 0)
+ else if (enif_compare(argv[0], atom_millisecond) == 0)
time_unit = ERL_NIF_MSEC;
- else if (enif_compare(argv[0], atom_micro_seconds) == 0)
+ else if (enif_compare(argv[0], atom_microsecond) == 0)
time_unit = ERL_NIF_USEC;
- else if (enif_compare(argv[0], atom_nano_seconds) == 0)
+ else if (enif_compare(argv[0], atom_nanosecond) == 0)
time_unit = ERL_NIF_NSEC;
else
time_unit = 4711; /* invalid time unit */
@@ -1856,24 +1856,24 @@ static ERL_NIF_TERM convert_time_unit(ErlNifEnv* env, int argc, const ERL_NIF_TE
val = (ErlNifTime) i64;
- if (enif_compare(argv[1], atom_seconds) == 0)
+ if (enif_compare(argv[1], atom_second) == 0)
from = ERL_NIF_SEC;
- else if (enif_compare(argv[1], atom_milli_seconds) == 0)
+ else if (enif_compare(argv[1], atom_millisecond) == 0)
from = ERL_NIF_MSEC;
- else if (enif_compare(argv[1], atom_micro_seconds) == 0)
+ else if (enif_compare(argv[1], atom_microsecond) == 0)
from = ERL_NIF_USEC;
- else if (enif_compare(argv[1], atom_nano_seconds) == 0)
+ else if (enif_compare(argv[1], atom_nanosecond) == 0)
from = ERL_NIF_NSEC;
else
from = 4711; /* invalid time unit */
- if (enif_compare(argv[2], atom_seconds) == 0)
+ if (enif_compare(argv[2], atom_second) == 0)
to = ERL_NIF_SEC;
- else if (enif_compare(argv[2], atom_milli_seconds) == 0)
+ else if (enif_compare(argv[2], atom_millisecond) == 0)
to = ERL_NIF_MSEC;
- else if (enif_compare(argv[2], atom_micro_seconds) == 0)
+ else if (enif_compare(argv[2], atom_microsecond) == 0)
to = ERL_NIF_USEC;
- else if (enif_compare(argv[2], atom_nano_seconds) == 0)
+ else if (enif_compare(argv[2], atom_nanosecond) == 0)
to = ERL_NIF_NSEC;
else
to = 4711; /* invalid time unit */
diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl
index 536c91d4ae..af18545bff 100644
--- a/erts/emulator/test/node_container_SUITE.erl
+++ b/erts/emulator/test/node_container_SUITE.erl
@@ -1092,7 +1092,7 @@ wait_until(Pred) ->
get_nodefirstname_string() ->
atom_to_list(?MODULE)
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive])).
diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl
index f91d84beea..ffe7d40139 100644
--- a/erts/emulator/test/old_scheduler_SUITE.erl
+++ b/erts/emulator/test/old_scheduler_SUITE.erl
@@ -309,13 +309,13 @@ receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) ->
%% uncomment lines below to get life sign (debug)
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) ->
- % T = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, milli_seconds),
+ % T = erlang:convert_time_unit(erlang:monotonic_time() - T0, native, millisecond),
% erlang:display({round(T/1000),P1Rs,P2Rs}),
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000);
receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) ->
Remain = Time - erlang:convert_time_unit(erlang:monotonic_time() - T0,
- native, milli_seconds), % test time remaining
+ native, millisecond), % test time remaining
Remain1 = if Remain < 0 ->
0;
true ->
diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl
index a9814d7df9..4323849465 100644
--- a/erts/emulator/test/port_SUITE.erl
+++ b/erts/emulator/test/port_SUITE.erl
@@ -1986,7 +1986,7 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) ->
Parent = self(),
io:format("SleepSecs = ~p~n", [SleepSecs]),
PortProg = "sleep " ++ integer_to_list(SleepSecs),
- Start = erlang:monotonic_time(micro_seconds),
+ Start = erlang:monotonic_time(microsecond),
NoProcs = case NoSchedsOnln of
NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS ->
NProcs;
@@ -2060,12 +2060,12 @@ exit_status_msb_test(Config, SleepSecs) when is_list(Config) ->
receive {P, started, SIds} -> SIds end
end,
Procs),
- StartedTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000,
+ StartedTime = (erlang:monotonic_time(microsecond) - Start)/1000000,
io:format("StartedTime = ~p~n", [StartedTime]),
true = StartedTime < SleepSecs,
erlang:system_flag(multi_scheduling, block),
lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs),
- DoneTime = (erlang:monotonic_time(micro_seconds) - Start)/1000000,
+ DoneTime = (erlang:monotonic_time(microsecond) - Start)/1000000,
io:format("DoneTime = ~p~n", [DoneTime]),
true = DoneTime > SleepSecs,
ok = verify_multi_scheduling_blocked(),
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index dae8990f56..0f999e0efe 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -372,7 +372,7 @@ eat_high(Low) ->
process_flag(priority, high),
receive after 1000 -> ok end,
exit(Low, {you, are, dead}),
- loop(erlang:monotonic_time() + erlang:convert_time_unit(5,seconds,native)).
+ loop(erlang:monotonic_time() + erlang:convert_time_unit(5,second,native)).
%% Busy loop for 5 seconds.
@@ -2376,7 +2376,7 @@ no_priority_inversion2(Config) when is_list(Config) ->
[{priority, max}, monitor, link])
end,
lists:seq(1, 2*erlang:system_info(schedulers))),
- receive after 500 -> ok end,
+ receive after 2000 -> ok end,
{PL, ML} = spawn_opt(fun () ->
tok_loop()
end,
@@ -2567,7 +2567,7 @@ start_node(Config, Args) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index f18d79d770..3aee15a8fc 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -793,13 +793,13 @@ update_cpu_info(Config) when is_list(Config) ->
io:format("START - Affinity mask: ~p - Schedulers online: ~p - Scheduler bindings: ~p~n",
[OldAff, OldOnline, erlang:system_info(scheduler_bindings)]),
case {erlang:system_info(logical_processors_available), OldAff} of
- {Avail, _} when Avail == unknown; OldAff == unknown ->
+ {Avail, _} when Avail == unknown; OldAff == unknown; OldAff == 1 ->
%% Nothing much to test; just a smoke test
case erlang:system_info(update_cpu_info) of
unchanged -> ok;
changed -> ok
end;
- _ ->
+ {Avail, _} ->
try
adjust_schedulers_online(),
case erlang:system_info(schedulers_online) of
@@ -810,7 +810,7 @@ update_cpu_info(Config) when is_list(Config) ->
%% unset least significant bit
Aff = (OldAff band (OldAff - 1)),
set_affinity_mask(Aff),
- Onln1 = Onln0 - 1,
+ Onln1 = Avail - 1,
case adjust_schedulers_online() of
{Onln0, Onln1} ->
Onln1 = erlang:system_info(schedulers_online),
@@ -1072,20 +1072,27 @@ scheduler_threads(Config) when is_list(Config) ->
{Sched, HalfSchedOnln, _} = get_sstate(Config, "+SP:50"),
%% Configure 2x scheduler threads only
{TwiceSched, SchedOnln, _} = get_sstate(Config, "+SP 200"),
- %% Test resetting the scheduler counts
- ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0",
- {Sched, SchedOnln, _} = get_sstate(Config, ResetCmd),
- %% Test negative +S settings, but only for SMP-enabled emulators
- case SmpSupport of
- false -> ok;
- true ->
- SchedMinus1 = Sched-1,
- SchedOnlnMinus1 = SchedOnln-1,
- {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"),
- {Sched, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"),
- {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1")
- end,
- ok.
+ case {erlang:system_info(logical_processors),
+ erlang:system_info(logical_processors_available)} of
+ {LProc, LProcAvail} when is_integer(LProc), is_integer(LProcAvail) ->
+ %% Test resetting the scheduler counts
+ ResetCmd = "+S "++FourSched++":"++FourSchedOnln++" +S 0:0",
+ {LProc, LProcAvail, _} = get_sstate(Config, ResetCmd),
+ %% Test negative +S settings, but only for SMP-enabled emulators
+ case {SmpSupport, LProc > 1, LProcAvail > 1} of
+ {true, true, true} ->
+ SchedMinus1 = LProc-1,
+ SchedOnlnMinus1 = LProcAvail-1,
+ {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1"),
+ {LProc, SchedOnlnMinus1, _} = get_sstate(Config, "+S :-1"),
+ {SchedMinus1, SchedOnlnMinus1, _} = get_sstate(Config, "+S -1:-1"),
+ ok;
+ _ ->
+ {comment, "Skipped reduced amount of schedulers test due to too few logical processors"}
+ end;
+ _ -> %% Skipped when missing info about logical processors...
+ {comment, "Skipped reset amount of schedulers test, and reduced amount of schedulers test due to too unknown amount of logical processors"}
+ end.
dirty_scheduler_threads(Config) when is_list(Config) ->
SmpSupport = erlang:system_info(smp_support),
@@ -1312,11 +1319,33 @@ scheduler_suspend_test(Config, Schedulers) ->
true ->
ok
end,
- erlang:system_info(schedulers_state)
+ until(fun () ->
+ {_A, B, C} = erlang:system_info(
+ schedulers_state),
+ B == C
+ end,
+ erlang:monotonic_time()
+ + erlang:convert_time_unit(1,
+ seconds,
+ native)),
+ erlang:system_info(schedulers_state)
end]),
stop_node(Node),
ok.
-
+
+until(Pred, MaxTime) ->
+ case Pred() of
+ true ->
+ true;
+ false ->
+ case erlang:monotonic_time() > MaxTime of
+ true ->
+ false;
+ false ->
+ receive after 100 -> ok end,
+ until(Pred, MaxTime)
+ end
+ end.
sst0_loop(0) ->
ok;
@@ -1978,10 +2007,10 @@ do_it(Tracer, Low, Normal, High, Max) ->
do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) ->
OldPrio = process_flag(priority, max),
go_work(Low, Normal, High, Max),
- StartWait = erlang:monotonic_time(milli_seconds),
+ StartWait = erlang:monotonic_time(millisecond),
%% Give the emulator a chance to balance the load...
wait_balance(5),
- EndWait = erlang:monotonic_time(milli_seconds),
+ EndWait = erlang:monotonic_time(millisecond),
BalanceWait = EndWait-StartWait,
erlang:display({balance_wait, BalanceWait}),
Timeout = (15 - 4)*60*1000 - BalanceWait,
@@ -2181,7 +2210,7 @@ start_node(Config, Args) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]).
diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl
index 0b11fa13f5..7e516176f7 100644
--- a/erts/emulator/test/signal_SUITE.erl
+++ b/erts/emulator/test/signal_SUITE.erl
@@ -484,7 +484,7 @@ repeat(Fun, N) when is_integer(N) ->
start_node(Config) ->
Name = list_to_atom(atom_to_list(?MODULE)
++ "-" ++ atom_to_list(proplists:get_value(testcase, Config))
- ++ "-" ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-" ++ integer_to_list(erlang:system_time(second))
++ "-" ++ integer_to_list(erlang:unique_integer([positive]))),
Pa = filename:dirname(code:which(?MODULE)),
test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]).
diff --git a/erts/emulator/test/smoke_test_SUITE.erl b/erts/emulator/test/smoke_test_SUITE.erl
index 042c7225d5..5eccdc562b 100644
--- a/erts/emulator/test/smoke_test_SUITE.erl
+++ b/erts/emulator/test/smoke_test_SUITE.erl
@@ -152,7 +152,7 @@ start_node(Config, Args) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
Opts = [{args, "-pa "++Pa++" "++Args}],
diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl
index 71ef003b25..a1f12ba93c 100644
--- a/erts/emulator/test/statistics_SUITE.erl
+++ b/erts/emulator/test/statistics_SUITE.erl
@@ -129,11 +129,15 @@ do_runtime_update(0) ->
{comment,"Never close enough"};
do_runtime_update(N) ->
{T1,Diff0} = statistics(runtime),
- spawn_link(fun cpu_heavy/0),
+ {CPUHog, CPUHogMon} = spawn_opt(fun cpu_heavy/0,[link,monitor]),
receive after 1000 -> ok end,
{T2,Diff} = statistics(runtime),
+ unlink(CPUHog),
+ exit(CPUHog, kill),
+
true = is_integer(T1+T2+Diff0+Diff),
io:format("T1 = ~p, T2 = ~p, Diff = ~p, T2-T1 = ~p", [T1,T2,Diff,T2-T1]),
+ receive {'DOWN',CPUHogMon,process,CPUHog,_} -> ok end,
if
T2 - T1 =:= Diff, 900 =< Diff, Diff =< 1500 -> ok;
true -> do_runtime_update(N-1)
@@ -311,8 +315,17 @@ scheduler_wall_time(Config) when is_list(Config) ->
true -> exit({fullload, FullLoad})
end,
- [exit(Pid, kill) || Pid <- [P1|HalfHogs++LastHogs]],
+ KillHog = fun (HP) ->
+ HPM = erlang:monitor(process, HP),
+ exit(HP, kill),
+ receive
+ {'DOWN', HPM, process, HP, killed} ->
+ ok
+ end
+ end,
+ [KillHog(Pid) || Pid <- [P1|HalfHogs++LastHogs]],
AfterLoad = get_load(),
+ io:format("AfterLoad=~p~n", [AfterLoad]),
{false,_} = {lists:any(fun(Load) -> Load > 25 end, AfterLoad),AfterLoad},
true = erlang:system_flag(scheduler_wall_time, false)
after
diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl
index f31d474c20..a4aedb31f6 100644
--- a/erts/emulator/test/system_info_SUITE.erl
+++ b/erts/emulator/test/system_info_SUITE.erl
@@ -508,7 +508,7 @@ start_node(Config, Envs) when is_list(Config) ->
++ "-"
++ atom_to_list(proplists:get_value(testcase, Config))
++ "-"
- ++ integer_to_list(erlang:system_time(seconds))
+ ++ integer_to_list(erlang:system_time(second))
++ "-"
++ integer_to_list(erlang:unique_integer([positive]))),
test_server:start_node(Name, peer, [{args, "-pa "++Pa}, {env, Envs}]).
diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl
index 87b8c62cfa..9501569814 100644
--- a/erts/emulator/test/time_SUITE.erl
+++ b/erts/emulator/test/time_SUITE.erl
@@ -295,7 +295,7 @@ timestamp(Config) when is_list(Config) ->
os_system_time_offset() ->
erlang:convert_time_unit(os:system_time() - erlang:monotonic_time(),
- native, micro_seconds).
+ native, microsecond).
had_time_warp(Secs) ->
had_time_warp(os_system_time_offset(), Secs).
@@ -488,12 +488,12 @@ check_time_warp_mode(Config, TimeCorrection, TimeWarpMode) ->
MonotonicTimeUnit = rpc:call(Node,
erlang,
convert_time_unit,
- [1, seconds, native]),
+ [1, second, native]),
UpMilliSeconds = erlang:convert_time_unit(MonotonicTime - StartTime,
MonotonicTimeUnit,
- milli_seconds),
+ millisecond),
io:format("UpMilliSeconds=~p~n", [UpMilliSeconds]),
- End = erlang:monotonic_time(milli_seconds),
+ End = erlang:monotonic_time(millisecond),
stop_node(Node),
try
true = (UpMilliSeconds > (98*MonotonicityTimeout) div 100),
@@ -810,10 +810,10 @@ do_check_erlang_timestamp(Done, Mon, TO) ->
MaxMon = erlang:monotonic_time(),
TsMin = erlang:convert_time_unit(MinMon+TO,
native,
- micro_seconds),
+ microsecond),
TsMax = erlang:convert_time_unit(MaxMon+TO,
native,
- micro_seconds),
+ microsecond),
TsTime = (MegaSec*1000000+Sec)*1000000+MicroSec,
case (TsMin =< TsTime) andalso (TsTime =< TsMax) of
true ->
diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl
index a5f11bd959..7cbd93a0f3 100644
--- a/erts/emulator/test/timer_bif_SUITE.erl
+++ b/erts/emulator/test/timer_bif_SUITE.erl
@@ -74,7 +74,7 @@ all() ->
%% Basic start_timer/3 functionality
start_timer_1(Config) when is_list(Config) ->
Ref1 = erlang:start_timer(1000, self(), plopp),
- ok = get(1100, {timeout, Ref1, plopp}),
+ ok = get(1400, {timeout, Ref1, plopp}),
false = erlang:read_timer(Ref1),
false = erlang:cancel_timer(Ref1),
@@ -83,12 +83,12 @@ start_timer_1(Config) when is_list(Config) ->
Ref2 = erlang:start_timer(1000, self(), plapp),
Left2 = erlang:cancel_timer(Ref2),
UpperLimit = 1000,
- true = (Left2 > 900) and (Left2 =< UpperLimit),
+ true = (Left2 > 600) and (Left2 =< UpperLimit),
empty = get_msg(),
false = erlang:cancel_timer(Ref2),
Ref3 = erlang:start_timer(1000, self(), plopp),
- no_message = get(900, {timeout, Ref3, plopp}),
+ no_message = get(600, {timeout, Ref3, plopp}),
ok.
%% Basic send_after/3 functionality
@@ -489,7 +489,7 @@ registered_process(Config) when is_list(Config) ->
same_time_yielding(Config) when is_list(Config) ->
Mem = mem(),
SchdlrsOnln = erlang:system_info(schedulers_online),
- Tmo = erlang:monotonic_time(milli_seconds) + 3000,
+ Tmo = erlang:monotonic_time(millisecond) + 3000,
Tmrs = lists:map(fun (I) ->
process_flag(scheduler, (I rem SchdlrsOnln) + 1),
erlang:start_timer(Tmo, self(), hej, [{abs, true}])
@@ -497,7 +497,7 @@ same_time_yielding(Config) when is_list(Config) ->
lists:seq(1, (?TIMEOUT_YIELD_LIMIT*3+1)*SchdlrsOnln)),
true = mem_larger_than(Mem),
lists:foreach(fun (Tmr) -> receive {timeout, Tmr, hej} -> ok end end, Tmrs),
- Done = erlang:monotonic_time(milli_seconds),
+ Done = erlang:monotonic_time(millisecond),
true = Done >= Tmo,
case erlang:system_info(build_type) of
opt -> true = Done < Tmo + 200;
@@ -517,10 +517,10 @@ same_time_yielding_with_cancel_other(Config) when is_list(Config) ->
do_cancel_tmrs(Tmo, Tmrs, Tester) ->
BeginCancel = erlang:convert_time_unit(Tmo,
- milli_seconds,
- micro_seconds) - 100,
+ millisecond,
+ microsecond) - 100,
busy_wait_until(fun () ->
- erlang:monotonic_time(micro_seconds) >= BeginCancel
+ erlang:monotonic_time(microsecond) >= BeginCancel
end),
lists:foreach(fun (Tmr) ->
erlang:cancel_timer(Tmr,
@@ -535,7 +535,7 @@ do_cancel_tmrs(Tmo, Tmrs, Tester) ->
same_time_yielding_with_cancel_test(Other, Accessor) ->
Mem = mem(),
SchdlrsOnln = erlang:system_info(schedulers_online),
- Tmo = erlang:monotonic_time(milli_seconds) + 3000,
+ Tmo = erlang:monotonic_time(millisecond) + 3000,
Tester = self(),
Cancelor = case Other of
false ->
@@ -656,7 +656,7 @@ get_msg() ->
start_slave() ->
Pa = filename:dirname(code:which(?MODULE)),
Name = atom_to_list(?MODULE)
- ++ "-" ++ integer_to_list(erlang:system_time(seconds))
+ ++ "-" ++ integer_to_list(erlang:system_time(second))
++ "-" ++ integer_to_list(erlang:unique_integer([positive])),
{ok, Node} = test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]),
Node.
diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl
index 491b37ae46..f60c777ba1 100644
--- a/erts/emulator/test/trace_bif_SUITE.erl
+++ b/erts/emulator/test/trace_bif_SUITE.erl
@@ -289,9 +289,9 @@ receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsTy
make_ts(timestamp) ->
erlang:now();
make_ts(monotonic_timestamp) ->
- erlang:monotonic_time(nano_seconds);
+ erlang:monotonic_time(nanosecond);
make_ts(strict_monotonic_timestamp) ->
- MT = erlang:monotonic_time(nano_seconds),
+ MT = erlang:monotonic_time(nanosecond),
UMI = erlang:unique_integer([monotonic]),
{MT, UMI}.
diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl
index 6582ad134b..26f96a1766 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -294,7 +294,7 @@ combo(Config) when is_list(Config) ->
T0 = erlang:monotonic_time(),
with_bif(Nbc),
T1 = erlang:monotonic_time(),
- TimeB = erlang:convert_time_unit(T1-T0, native, micro_seconds),
+ TimeB = erlang:convert_time_unit(T1-T0, native, microsecond),
%%
List = collect(100),
@@ -655,13 +655,13 @@ execute(Pids, Mfa) when is_list(Pids) ->
[P ! {self(), execute, Mfa} || P <- Pids],
As = [receive {P, answer, Answer} -> Answer end || P <- Pids],
T1 = erlang:monotonic_time(),
- {As, erlang:convert_time_unit(T1-T0, native, micro_seconds)};
+ {As, erlang:convert_time_unit(T1-T0, native, microsecond)};
execute(P, Mfa) ->
T0 = erlang:monotonic_time(),
P ! {self(), execute, Mfa},
A = receive {P, answer, Answer} -> Answer end,
T1 = erlang:monotonic_time(),
- {A, erlang:convert_time_unit(T1-T0, native, micro_seconds)}.
+ {A, erlang:convert_time_unit(T1-T0, native, microsecond)}.
diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl
index d1085c1958..ab56018373 100644
--- a/erts/emulator/test/z_SUITE.erl
+++ b/erts/emulator/test/z_SUITE.erl
@@ -191,7 +191,13 @@ node_container_refc_check(Config) when is_list(Config) ->
ok.
long_timers(Config) when is_list(Config) ->
- ok = long_timers_test:check_result().
+ case long_timers_test:check_result() of
+ ok -> ok;
+ high_cpu -> {comment, "Ignored failures due to high CPU utilization"};
+ missing_cpu_info -> {comment, "Ignored failures due to missing CPU utilization information"};
+ Fail -> ct:fail(Fail)
+ end.
+
pollset_size(Config) when is_list(Config) ->
Name = pollset_size_testcase_initial_state_holder,
diff --git a/erts/example/time_compat.erl b/erts/example/time_compat.erl
index b87c6cc550..589781c8e8 100644
--- a/erts/example/time_compat.erl
+++ b/erts/example/time_compat.erl
@@ -272,6 +272,10 @@ system_flag(Flag, Value) ->
%%
integer_time_unit(native) -> 1000*1000;
+integer_time_unit(nanosecond) -> 1000*1000*1000;
+integer_time_unit(microsecond) -> 1000*1000;
+integer_time_unit(millisecond) -> 1000;
+integer_time_unit(second) -> 1;
integer_time_unit(nano_seconds) -> 1000*1000*1000;
integer_time_unit(micro_seconds) -> 1000*1000;
integer_time_unit(milli_seconds) -> 1000;
diff --git a/erts/include/internal/erl_misc_utils.h b/erts/include/internal/erl_misc_utils.h
index a4a5d1d510..55566ddf74 100644
--- a/erts/include/internal/erl_misc_utils.h
+++ b/erts/include/internal/erl_misc_utils.h
@@ -56,4 +56,33 @@ int erts_map_win_error_to_errno(DWORD win_error);
int erts_get_last_win_errno(void);
#endif
+#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__)
+#define __DARWIN__ 1
+#endif
+
+/*
+ * ERTS_PREMATURE_TIMEOUT() expects time units
+ * 1000 (millisec), 1000000 (microsec), or
+ * 1000000000 (nanosec). Might not work properly
+ * otherwise.
+ */
+#undef ERTS_USE_PREMATURE_TIMEOUT
+#undef ERTS_PREMATURE_TIMEOUT
+
+#if defined(__DARWIN__)
+#define ERTS_USE_PREMATURE_TIMEOUT 1
+#define ERTS_PREMATURE_TIMEOUT(TMO, TU) \
+ ((TMO) >= 1 * ((TU) / 1000) \
+ ? ((TMO) >= 20 * ((TU) / 1000) \
+ ? 15 * ((TU) / 1000) \
+ : ((TMO) >= 5 * ((TU) / 1000) \
+ ? 3 * ((TU) / 1000) \
+ : 5 * ((TU) / 10000))) \
+ : 0)
+
+#else
+#define ERTS_USE_PREMATURE_TIMEOUT 0
+#define ERTS_PREMATURE_TIMEOUT(TMO, TU) (0)
+#endif
+
#endif /* #ifndef ERL_MISC_UTILS_H_ */
diff --git a/erts/lib_src/pthread/ethr_event.c b/erts/lib_src/pthread/ethr_event.c
index eef88d5002..464875570a 100644
--- a/erts/lib_src/pthread/ethr_event.c
+++ b/erts/lib_src/pthread/ethr_event.c
@@ -184,6 +184,8 @@ return_event_on:
#include <errno.h>
#include <string.h>
+#include "erl_misc_utils.h"
+
#ifdef __DARWIN__
struct ethr_event_fdsets___ {
@@ -346,12 +348,9 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
ethr_sint32_t val;
int res, ulres;
int until_yield = ETHR_YIELD_AFTER_BUSY_LOOPS;
- ethr_sint64_t time = 0; /* SHUT UP annoying faulty warning... */
+ ethr_sint64_t time = 0;
#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME
- ethr_sint64_t start = 0; /* SHUT UP annoying faulty warning... */
-#endif
-#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC
- struct timespec cond_timeout;
+ ethr_sint64_t timeout_time = 0; /* SHUT UP annoying faulty warning... */
#endif
val = ethr_atomic32_read(&e->state);
@@ -365,30 +364,27 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
if (timeout == 0)
return ETIMEDOUT;
else {
- time = timeout;
- switch (e->fd[0]) {
- case ETHR_EVENT_INVALID_FD__:
#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME
- start = ethr_get_monotonic_time();
+ timeout_time = ethr_get_monotonic_time();
+ timeout_time += timeout;
#endif
+ switch (e->fd[0]) {
+ case ETHR_EVENT_INVALID_FD__:
+ time = timeout;
setup_nonblocking_pipe(e);
break;
#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC
case ETHR_EVENT_COND_TIMEDWAIT__:
- time += ethr_get_monotonic_time();
- cond_timeout.tv_sec = time / (1000*1000*1000);
- cond_timeout.tv_nsec = time % (1000*1000*1000);
+ time = -1;
if (spincount == 0)
goto set_event_off_waiter;
break;
#endif
default:
+ time = timeout;
/* Already initialized pipe... */
if (spincount == 0)
goto set_select_timeout;
-#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME
- start = ethr_get_monotonic_time();
-#endif
break;
}
}
@@ -418,6 +414,9 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
|| e->fd[0] == ETHR_EVENT_COND_TIMEDWAIT__
#endif
) {
+#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC
+ struct timespec cond_timeout;
+#endif
set_event_off_waiter:
@@ -446,9 +445,35 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
#ifdef ETHR_HAVE_PTHREAD_COND_TIMEDWAIT_MONOTONIC
if (timeout > 0) {
+ if (time != timeout_time) {
+ time = timeout_time;
+
+#if ERTS_USE_PREMATURE_TIMEOUT
+ {
+ ethr_sint64_t rtmo;
+
+ rtmo = timeout_time - ethr_get_monotonic_time();
+ if (rtmo <= 0) {
+ res = ETIMEDOUT;
+ break;
+ }
+ time = timeout_time;
+ time -= ERTS_PREMATURE_TIMEOUT(rtmo, 1000*1000*1000);
+ }
+#endif
+
+ cond_timeout.tv_sec = time / (1000*1000*1000);
+ cond_timeout.tv_nsec = time % (1000*1000*1000);
+ }
res = pthread_cond_timedwait(&e->cnd, &e->mtx, &cond_timeout);
- if (res == EINTR || res == ETIMEDOUT)
+ if (res == EINTR
+ || (res == ETIMEDOUT
+#if ERTS_USE_PREMATURE_TIMEOUT
+ && time == timeout_time
+#endif
+ )) {
break;
+ }
}
else
#endif
@@ -477,7 +502,11 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
struct timeval select_timeout;
#ifdef ETHR_HAVE_ETHR_GET_MONOTONIC_TIME
- time -= ethr_get_monotonic_time() - start;
+#if ERTS_USE_PREMATURE_TIMEOUT
+ restart_select:
+#endif
+
+ time = timeout_time - ethr_get_monotonic_time();
if (time <= 0)
return ETIMEDOUT;
#endif
@@ -492,6 +521,11 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
*/
time = ((time - 1) / 1000) + 1;
+#if defined(ETHR_HAVE_ETHR_GET_MONOTONIC_TIME) \
+ && ERTS_USE_PREMATURE_TIMEOUT
+ time -= ERTS_PREMATURE_TIMEOUT(time, 1000*1000);
+#endif
+
select_timeout.tv_sec = time / (1000*1000);
select_timeout.tv_usec = time % (1000*1000);
@@ -559,7 +593,11 @@ wait__(ethr_event *e, int spincount, ethr_sint64_t timeout)
val = ethr_atomic32_read(&e->state);
if (val == ETHR_EVENT_ON__)
goto return_event_on;
-
+#if defined(ETHR_HAVE_ETHR_GET_MONOTONIC_TIME) \
+ && ERTS_USE_PREMATURE_TIMEOUT
+ if (res == ETIMEDOUT)
+ goto restart_select; /* Verify timeout */
+#endif
}
return res;
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index b62da04bfd..c68debeabc 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
Binary files differ
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index edf79b8f75..652a954807 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -59,6 +59,7 @@
-export_type([timestamp/0]).
-export_type([time_unit/0]).
+-export_type([deprecated_time_unit/0]).
-type ext_binary() :: binary().
-type timestamp() :: {MegaSecs :: non_neg_integer(),
@@ -67,12 +68,20 @@
-type time_unit() ::
pos_integer()
- | 'seconds'
+ | 'second'
+ | 'millisecond'
+ | 'microsecond'
+ | 'nanosecond'
+ | 'native'
+ | 'perf_counter'
+ | deprecated_time_unit().
+
+%% Deprecated symbolic units...
+-type deprecated_time_unit() ::
+ 'seconds'
| 'milli_seconds'
| 'micro_seconds'
- | 'nano_seconds'
- | 'native'
- | 'perf_counter'.
+ | 'nano_seconds'.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Native code BIF stubs and their types
@@ -1365,19 +1374,33 @@ convert_time_unit(Time, FromUnit, ToUnit) ->
FU = case FromUnit of
native -> erts_internal:time_unit();
perf_counter -> erts_internal:perf_counter_unit();
+ nanosecond -> 1000*1000*1000;
+ microsecond -> 1000*1000;
+ millisecond -> 1000;
+ second -> 1;
+
+ %% Deprecated symbolic units...
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
seconds -> 1;
+
_ when FromUnit > 0 -> FromUnit
end,
TU = case ToUnit of
native -> erts_internal:time_unit();
perf_counter -> erts_internal:perf_counter_unit();
+ nanosecond -> 1000*1000*1000;
+ microsecond -> 1000*1000;
+ millisecond -> 1000;
+ second -> 1;
+
+ %% Deprecated symbolic units...
nano_seconds -> 1000*1000*1000;
micro_seconds -> 1000*1000;
milli_seconds -> 1000;
seconds -> 1;
+
_ when ToUnit > 0 -> ToUnit
end,
case Time < 0 of
diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl
index 281a47134f..d474c71c4f 100644
--- a/erts/test/z_SUITE.erl
+++ b/erts/test/z_SUITE.erl
@@ -214,7 +214,19 @@ dump_core(#core_search_conf{ cerl = Cerl }, Core) ->
format_core(Conf, {ignore, Core}) ->
format_core(Conf, Core, "[ignored] ");
format_core(Conf, Core) ->
- format_core(Conf, Core, "").
+ format_core(Conf, Core, ""),
+
+ %% Try print (log dir) name of offending application
+ CoreDir = filename:dirname(Core),
+ lists:foreach(fun(TestDir) ->
+ case filelib:is_dir(filename:join(CoreDir,TestDir)) of
+ true ->
+ io:format(" from ~s~n", [TestDir]);
+ false ->
+ no
+ end
+ end,
+ filelib:wildcard("*.logs", CoreDir)).
format_core(#core_search_conf{file = false}, Core, Ignore) ->
io:format(" ~s~s " ++ time_fstr() ++ "~s~n",
diff --git a/lib/common_test/src/ct_make.erl b/lib/common_test/src/ct_make.erl
index e7a9cfa843..f22959d457 100644
--- a/lib/common_test/src/ct_make.erl
+++ b/lib/common_test/src/ct_make.erl
@@ -342,5 +342,7 @@ check_includes2(Epp, File, ObjMTime) ->
epp:close(Epp),
false;
{error, _Error} ->
+ check_includes2(Epp, File, ObjMTime);
+ {warning, _Warning} ->
check_includes2(Epp, File, ObjMTime)
end.
diff --git a/lib/common_test/src/erl2html2.erl b/lib/common_test/src/erl2html2.erl
index e819f345de..7f3eb699de 100644
--- a/lib/common_test/src/erl2html2.erl
+++ b/lib/common_test/src/erl2html2.erl
@@ -130,6 +130,8 @@ parse_preprocessed_file(Epp, File, InCorrectFile) ->
throw({error,Reason,InCorrectFile});
{error,_Reason} ->
parse_preprocessed_file(Epp, File, InCorrectFile);
+ {warning,_} ->
+ parse_preprocessed_file(Epp, File, InCorrectFile);
{eof,_Location} ->
[]
end.
diff --git a/lib/common_test/test/ct_auto_compile_SUITE.erl b/lib/common_test/test/ct_auto_compile_SUITE.erl
index e6939d23c0..dface99b8f 100644
--- a/lib/common_test/test/ct_auto_compile_SUITE.erl
+++ b/lib/common_test/test/ct_auto_compile_SUITE.erl
@@ -27,6 +27,7 @@
%%% The suites used for the test are located in the data directory.
%%%-------------------------------------------------------------------
-module(ct_auto_compile_SUITE).
+-warning("Ignore me -- testing that the debugger can handle warnings").
-compile(export_all).
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index d0044fe723..ce149aa96a 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -108,6 +108,7 @@
#if OPENSSL_VERSION_NUMBER >= OpenSSL_version_plain(1,0,1)
# define HAVE_EVP_AES_CTR
# define HAVE_GCM
+# define HAVE_CMAC
# if OPENSSL_VERSION_NUMBER < OpenSSL_version(1,0,1,'d')
# define HAVE_GCM_EVP_DECRYPT_BUG
# endif
@@ -121,6 +122,10 @@
# define HAVE_ECB_IVEC_BUG
#endif
+#if defined(HAVE_CMAC)
+#include <openssl/cmac.h>
+#endif
+
#if defined(HAVE_EC)
#include <openssl/ec.h>
#include <openssl/ecdh.h>
@@ -224,6 +229,7 @@ static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -294,6 +300,7 @@ static ErlNifFunc nif_funcs[] = {
{"hmac_update_nif", 2, hmac_update_nif},
{"hmac_final_nif", 1, hmac_final_nif},
{"hmac_final_nif", 2, hmac_final_nif},
+ {"cmac_nif", 3, cmac_nif},
{"block_crypt_nif", 5, block_crypt_nif},
{"block_crypt_nif", 4, block_crypt_nif},
{"aes_ige_crypt_nif", 4, aes_ige_crypt_nif},
@@ -1346,6 +1353,53 @@ static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
return ret;
}
+static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Type, Key, Data) */
+#if defined(HAVE_CMAC)
+ struct cipher_type_t *cipherp = NULL;
+ const EVP_CIPHER *cipher;
+ CMAC_CTX *ctx;
+ ErlNifBinary key;
+ ErlNifBinary data;
+ ERL_NIF_TERM ret;
+ size_t ret_size;
+
+ if (!enif_inspect_iolist_as_binary(env, argv[1], &key)
+ || !(cipherp = get_cipher_type(argv[0], key.size))
+ || !enif_inspect_iolist_as_binary(env, argv[2], &data)) {
+ return enif_make_badarg(env);
+ }
+ cipher = cipherp->cipher.p;
+ if (!cipher) {
+ return enif_raise_exception(env, atom_notsup);
+ }
+
+ ctx = CMAC_CTX_new();
+ if (!CMAC_Init(ctx, key.data, key.size, cipher, NULL)) {
+ CMAC_CTX_free(ctx);
+ return atom_notsup;
+ }
+
+ if (!CMAC_Update(ctx, data.data, data.size) ||
+ !CMAC_Final(ctx,
+ enif_make_new_binary(env, EVP_CIPHER_block_size(cipher), &ret),
+ &ret_size)) {
+ CMAC_CTX_free(ctx);
+ return atom_notsup;
+ }
+ ASSERT(ret_size == (unsigned)EVP_CIPHER_block_size(cipher));
+
+ CMAC_CTX_free(ctx);
+ CONSUME_REDS(env, data);
+ return ret;
+#else
+ /* The CMAC functionality was introduced in OpenSSL 1.0.1
+ * Although OTP requires at least version 0.9.8, the versions 0.9.8 and 1.0.0 are
+ * no longer maintained. */
+ return atom_notsup;
+#endif
+}
+
static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Key, Ivec, Text, IsEncrypt) or (Type, Key, Text, IsEncrypt) */
struct cipher_type_t *cipherp = NULL;
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 5a5627747c..50e3583a94 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -41,6 +41,9 @@
<p>Hmac functions - <url href="http://www.ietf.org/rfc/rfc2104.txt"> Keyed-Hashing for Message Authentication (RFC 2104) </url></p>
</item>
<item>
+ <p>Cmac functions - <url href="http://www.ietf.org/rfc/rfc4493.txt">The AES-CMAC Algorithm (RFC 4493)</url></p>
+ </item>
+ <item>
<p>Block ciphers - <url href="http://csrc.nist.gov/groups/ST/toolkit/block_ciphers.html"> </url> DES and AES in
Block Cipher Modes - <url href="http://csrc.nist.gov/groups/ST/toolkit/BCM/index.html"> ECB, CBC, CFB, OFB, CTR and GCM </url></p>
</item>
@@ -454,6 +457,24 @@
</func>
<func>
+ <name>cmac(Type, Key, Data) -> Mac</name>
+ <name>cmac(Type, Key, Data, MacLength) -> Mac</name>
+ <fsummary>Calculates the Cipher-based Message Authentication Code.</fsummary>
+ <type>
+ <v>Type = block_cipher()</v>
+ <v>Key = iodata()</v>
+ <v>Data = iodata()</v>
+ <v>MacLength = integer()</v>
+ <v>Mac = binary()</v>
+ </type>
+ <desc>
+ <p>Computes a CMAC of type <c>Type</c> from <c>Data</c> using
+ <c>Key</c> as the authentication key.</p> <p><c>MacLength</c>
+ will limit the size of the resultant <c>Mac</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name>info_lib() -> [{Name,VerNum,VerStr}]</name>
<fsummary>Provides information about the libraries used by crypto.</fsummary>
<type>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 025d57e9c5..ba824eb9cd 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -27,6 +27,7 @@
-export([sign/4, verify/5]).
-export([generate_key/2, generate_key/3, compute_key/4]).
-export([hmac/3, hmac/4, hmac_init/2, hmac_update/2, hmac_final/1, hmac_final_n/2]).
+-export([cmac/3, cmac/4]).
-export([exor/2, strong_rand_bytes/1, mod_pow/3]).
-export([rand_uniform/2]).
-export([block_encrypt/3, block_decrypt/3, block_encrypt/4, block_decrypt/4]).
@@ -271,6 +272,14 @@ hmac_final(Context) ->
hmac_final_n(Context, HashLen) ->
notsup_to_error(hmac_final_nif(Context, HashLen)).
+-spec cmac(_, iodata(), iodata()) -> binary().
+-spec cmac(_, iodata(), iodata(), integer()) -> binary().
+
+cmac(Type, Key, Data) ->
+ notsup_to_error(cmac_nif(Type, Key, Data)).
+cmac(Type, Key, Data, MacSize) ->
+ erlang:binary_part(cmac(Type, Key, Data), 0, MacSize).
+
%% Ecrypt/decrypt %%%
-spec block_encrypt(des_cbc | des_cfb |
@@ -782,6 +791,10 @@ hmac_update_nif(_Context, _Data) -> ?nif_stub.
hmac_final_nif(_Context) -> ?nif_stub.
hmac_final_nif(_Context, _MacSize) -> ?nif_stub.
+%% CMAC
+
+cmac_nif(_Type, _Key, _Data) -> ?nif_stub.
+
%%
%% MD5_MAC
%%
@@ -1460,6 +1473,7 @@ mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub.
-define(FUNC_LIST, [hash, hash_init, hash_update, hash_final,
hmac, hmac_init, hmac_update, hmac_final, hmac_final_n,
+ cmac,
%% deprecated
md4, md4_init, md4_update, md4_final,
md5, md5_init, md5_update, md5_final,
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 6732f27824..c445b465c7 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -95,10 +95,10 @@ groups() ->
{des_ede3,[], [block]},
{des3_cbf,[], [block]},
{rc2_cbc,[], [block]},
- {aes_cbc128,[], [block]},
+ {aes_cbc128,[], [block, cmac]},
{aes_cfb8,[], [block]},
{aes_cfb128,[], [block]},
- {aes_cbc256,[], [block]},
+ {aes_cbc256,[], [block, cmac]},
{aes_ecb,[], [block]},
{aes_ige256,[], [block]},
{blowfish_cbc, [], [block]},
@@ -152,6 +152,14 @@ end_per_group(_GroupName, Config) ->
init_per_testcase(info, Config) ->
Config;
+init_per_testcase(cmac, Config) ->
+ case crypto:info_lib() of
+ [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer), LibVer > 16#10001000 ->
+ Config;
+ _Else ->
+ % The CMAC functionality was introduced in OpenSSL 1.0.1
+ {skip, "OpenSSL is too old"}
+ end;
init_per_testcase(_Name,Config) ->
Config.
@@ -194,6 +202,13 @@ hmac(Config) when is_list(Config) ->
hmac(Type, lists:map(fun iolistify/1, Keys), lists:map(fun iolistify/1, Data), Expected),
hmac_increment(Type).
%%--------------------------------------------------------------------
+cmac() ->
+ [{doc, "Test all different cmac functions"}].
+cmac(Config) when is_list(Config) ->
+ Pairs = proplists:get_value(cmac, Config),
+ lists:foreach(fun cmac_check/1, Pairs),
+ lists:foreach(fun cmac_check/1, cmac_iolistify(Pairs)).
+%%--------------------------------------------------------------------
block() ->
[{doc, "Test block ciphers"}].
block(Config) when is_list(Config) ->
@@ -346,6 +361,23 @@ hmac_increment(State0, [Increment | Rest]) ->
State = crypto:hmac_update(State0, Increment),
hmac_increment(State, Rest).
+cmac_check({Type, Key, Text, CMac}) ->
+ ExpCMac = iolist_to_binary(CMac),
+ case crypto:cmac(Type, Key, Text) of
+ ExpCMac ->
+ ok;
+ Other ->
+ ct:fail({{crypto, cmac, [Type, Key, Text]}, {expected, ExpCMac}, {got, Other}})
+ end;
+cmac_check({Type, Key, Text, Size, CMac}) ->
+ ExpCMac = iolist_to_binary(CMac),
+ case crypto:cmac(Type, Key, Text, Size) of
+ ExpCMac ->
+ ok;
+ Other ->
+ ct:fail({{crypto, cmac, [Type, Key, Text, Size]}, {expected, ExpCMac}, {got, Other}})
+ end.
+
block_cipher({Type, Key, PlainText}) ->
Plain = iolist_to_binary(PlainText),
CipherText = crypto:block_encrypt(Type, Key, PlainText),
@@ -566,11 +598,18 @@ mkint(C) when $a =< C, C =< $f ->
is_supported(Group) ->
lists:member(Group, lists:append([Algo || {_, Algo} <- crypto:supports()])).
+cmac_iolistify(Blocks) ->
+ lists:map(fun do_cmac_iolistify/1, Blocks).
block_iolistify(Blocks) ->
lists:map(fun do_block_iolistify/1, Blocks).
stream_iolistify(Streams) ->
lists:map(fun do_stream_iolistify/1, Streams).
+do_cmac_iolistify({Type, Key, Text, CMac}) ->
+ {Type, iolistify(Key), iolistify(Text), CMac};
+do_cmac_iolistify({Type, Key, Text, Size, CMac}) ->
+ {Type, iolistify(Key), iolistify(Text), Size, CMac}.
+
do_stream_iolistify({Type, Key, PlainText}) ->
{Type, iolistify(Key), iolistify(PlainText)};
do_stream_iolistify({Type, Key, IV, PlainText}) ->
@@ -798,12 +837,14 @@ group_config(des_ede3, Config) ->
group_config(rc2_cbc, Config) ->
Block = rc2_cbc(),
[{block, Block} | Config];
-group_config(aes_cbc128, Config) ->
+group_config(aes_cbc128 = Type, Config) ->
Block = aes_cbc128(),
- [{block, Block} | Config];
-group_config(aes_cbc256, Config) ->
+ Pairs = cmac_nist(Type),
+ [{block, Block}, {cmac, Pairs} | Config];
+group_config(aes_cbc256 = Type, Config) ->
Block = aes_cbc256(),
- [{block, Block} | Config];
+ Pairs = cmac_nist(Type),
+ [{block, Block}, {cmac, Pairs} | Config];
group_config(aes_ecb, Config) ->
Block = aes_ecb(),
[{block, Block} | Config];
@@ -2324,6 +2365,50 @@ ecc() ->
end,
TestCases).
+%% Test data from Appendix D of NIST Special Publication 800-38B
+%% http://csrc.nist.gov/publications/nistpubs/800-38B/Updated_CMAC_Examples.pdf
+%% The same AES128 test data are also in the RFC 4493
+%% https://tools.ietf.org/html/rfc4493
+cmac_nist(aes_cbc128 = Type) ->
+ Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"),
+ [{Type, Key, <<"">>,
+ hexstr2bin("bb1d6929e95937287fa37d129b756746")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"),
+ hexstr2bin("070a16b46b4d4144f79bdd9dd04a287c")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411"),
+ hexstr2bin("dfa66747de9ae63030ca32611497c827")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710"),
+ hexstr2bin("51f0bebf7e3b9d92fc49741779363cfe")},
+ % truncation
+ {Type, Key, <<"">>, 4,
+ hexstr2bin("bb1d6929")}];
+
+cmac_nist(aes_cbc256 = Type) ->
+ Key = hexstr2bin("603deb1015ca71be2b73aef0857d7781"
+ "1f352c073b6108d72d9810a30914dff4"),
+ [{Type, Key, <<"">>,
+ hexstr2bin("028962f61b7bf89efc6b551f4667d983")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"),
+ hexstr2bin("28a7023f452e8f82bd4bf28d8c37c35c")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411"),
+ hexstr2bin("aaf3d8f1de5640c232f5b169b9c911e6")},
+ {Type, Key, hexstr2bin("6bc1bee22e409f96e93d7e117393172a"
+ "ae2d8a571e03ac9c9eb76fac45af8e51"
+ "30c81c46a35ce411e5fbc1191a0a52ef"
+ "f69f2445df4f9b17ad2b417be66c3710"),
+ hexstr2bin("e1992190549f6ed5696a2c056c315410")},
+ % truncation
+ {Type, Key, <<"">>, 4,
+ hexstr2bin("028962f6")}].
+
+
no_padding() ->
Public = [_, Mod] = rsa_public(),
Private = rsa_private(),
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 976a2b8955..a72368f9f8 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -768,19 +768,9 @@ picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, Acc) ->
end.
extra_contract_warning(MFA, WarningInfo, Contract, CSig, Sig, RecDict) ->
- %% We do not want to depend upon erl_types:t_to_string() possibly
- %% hiding the contents of opaque types.
- SigUnopaque = erl_types:t_unopaque(Sig),
- CSigUnopaque = erl_types:t_unopaque(CSig),
- SigString0 =
- lists:flatten(dialyzer_utils:format_sig(SigUnopaque, RecDict)),
- ContractString0 =
- lists:flatten(dialyzer_utils:format_sig(CSigUnopaque, RecDict)),
- %% The only difference is in record fields containing 'undefined' or not.
- IsUndefRecordFieldsRelated = SigString0 =:= ContractString0,
{IsRemoteTypesRelated, SubtypeRelation} =
is_remote_types_related(Contract, CSig, Sig, MFA, RecDict),
- case IsUndefRecordFieldsRelated orelse IsRemoteTypesRelated of
+ case IsRemoteTypesRelated of
true ->
no_warning;
false ->
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
index 50991c9bc5..cb6a88786e 100644
--- a/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/behaviour_SUITE_data/dialyzer_options
@@ -1 +1,2 @@
{dialyzer_options, []}.
+{time_limit, 2}.
diff --git a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
index 3ff26b87db..ffdf8270c8 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
+++ b/lib/dialyzer/test/opaque_SUITE_data/dialyzer_options
@@ -1 +1,2 @@
{dialyzer_options, [{warnings, [no_unused, no_return]}]}.
+{time_limit, 2}.
diff --git a/lib/erl_interface/src/connect/ei_connect.c b/lib/erl_interface/src/connect/ei_connect.c
index 6dc51adee1..624100ad49 100644
--- a/lib/erl_interface/src/connect/ei_connect.c
+++ b/lib/erl_interface/src/connect/ei_connect.c
@@ -1708,28 +1708,36 @@ error:
static int get_home(char *buf, int size)
{
- char* homedrive;
- char* homepath;
-
#ifdef __WIN32__
- homedrive = getenv("HOMEDRIVE");
- homepath = getenv("HOMEPATH");
-#else
- homedrive = "";
- homepath = getenv("HOME");
-#endif
+ char* homedrive = getenv("HOMEDRIVE");
+ char* homepath = getenv("HOMEPATH");
- if (!homedrive || !homepath) {
- buf[0] = '.';
- buf[1] = '\0';
- return 1;
- } else if (strlen(homedrive)+strlen(homepath) < size-1) {
+ if (homedrive && homepath) {
+ if (strlen(homedrive)+strlen(homepath) >= size)
+ return 0;
strcpy(buf, homedrive);
strcat(buf, homepath);
return 1;
}
-
- return 0;
+ else {
+ int len = GetWindowsDirectory(buf, size);
+ if (len) {
+ return (len < size);
+ }
+ }
+#else
+ char* homepath = getenv("HOME");
+ if (homepath) {
+ if (strlen(homepath) >= size)
+ return 0;
+ strcpy(buf, homepath);
+ return 1;
+ }
+#endif
+
+ buf[0] = '.';
+ buf[1] = '\0';
+ return 1;
}
diff --git a/lib/erl_interface/src/misc/ei_portio.h b/lib/erl_interface/src/misc/ei_portio.h
index fbb61b0ccf..bded811a35 100644
--- a/lib/erl_interface/src/misc/ei_portio.h
+++ b/lib/erl_interface/src/misc/ei_portio.h
@@ -21,7 +21,7 @@
*/
#ifndef _EI_PORTIO_H
#define _EI_PORTIO_H
-#if !defined(__WIN32__) || !defined(VXWORKS)
+#if !defined(__WIN32__) && !defined(VXWORKS)
#ifdef HAVE_WRITEV
/* Declaration of struct iovec *iov should be visible in this scope. */
#include <sys/uio.h>
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 243bb6e25d..c9dd1051f3 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -4749,7 +4749,7 @@ type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) ->
{Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames),
Rep1 = choose_opaque_type(Rep, Type),
Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of
- true -> Rep1;
+ true -> Rep;
false ->
ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
t_opaque(Module, Name, ArgTypes2, Rep1)
@@ -4821,7 +4821,7 @@ remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames,
NewRep1 = choose_opaque_type(NewRep, Type),
NewRep2 =
case cannot_have_opaque(NewRep1, RemType, TypeNames) of
- true -> NewRep1;
+ true -> NewRep;
false ->
ArgTypes2 = subst_all_vars_to_any_list(ArgTypes),
t_opaque(Mod, Name, ArgTypes2, NewRep1)
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 864f8facac..59a046bf4d 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -83,7 +83,7 @@
<c><![CDATA[SIGKILL]]></c>:</p>
<pre>
% <input>erl -heart -env HEART_KILL_SIGNAL SIGABRT ...</input></pre>
- <p> If heart should <b>not</b> kill the Erlang runtime system, this can be indicated
+ <p> If heart should <em>not</em> kill the Erlang runtime system, this can be indicated
using the environment variable <c><![CDATA[HEART_NO_KILL=TRUE]]></c>.
This can be useful if the command executed by heart takes care of this,
for example as part of a specific cleanup sequence.
diff --git a/lib/kernel/doc/src/kernel_app.xml b/lib/kernel/doc/src/kernel_app.xml
index dc0291babe..fb6421e1c5 100644
--- a/lib/kernel/doc/src/kernel_app.xml
+++ b/lib/kernel/doc/src/kernel_app.xml
@@ -215,16 +215,16 @@
<p>Defines the <c>First..Last</c> port range for the listener
socket of a distributed Erlang node.</p>
</item>
- <marker id="inet_dist_listen_options"></marker>
<tag><c>{inet_dist_listen_options, Opts}</c></tag>
<item>
+ <marker id="inet_dist_listen_options"></marker>
<p>Defines a list of extra socket options to be used when opening the
listening socket for a distributed Erlang node.
See <seealso marker="gen_tcp#listen/2"><c>gen_tcp:listen/2</c></seealso>.</p>
</item>
- <marker id="inet_dist_connect_options"></marker>
<tag><c>{inet_dist_connect_options, Opts}</c></tag>
<item>
+ <marker id="inet_dist_connect_options"></marker>
<p>Defines a list of extra socket options to be used when connecting to
other distributed Erlang nodes.
See <seealso marker="gen_tcp#connect/4"><c>gen_tcp:connect/4</c></seealso>.</p>
diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl
index 59f6443551..968a7620aa 100644
--- a/lib/observer/src/observer_tv_wx.erl
+++ b/lib/observer/src/observer_tv_wx.erl
@@ -124,6 +124,8 @@ handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0})
end,
case get_tables2(Node, Opt) of
Error = {error, _} ->
+ Id =:= ?ID_MNESIA andalso
+ wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true),
self() ! Error,
{noreply, State};
Tables ->
@@ -217,22 +219,32 @@ handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt,
{noreply, State#state{tabs=Tabs}}
end;
-handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt,
+handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0,
timer=Timer0}) ->
- Tables = get_tables(Node, Opt),
+ {Tables, Opt} = case Opt0#opt.type =:= mnesia andalso get_tables2(Node, Opt0) of
+ Ts when is_list(Ts) ->
+ {Ts, Opt0};
+ _ -> % false or error getting mnesia tables
+ Opt1 = Opt0#opt{type=ets},
+ {get_tables(Node, Opt1), Opt1}
+ end,
Tabs = update_grid(Grid, Opt, Tables),
wxWindow:setFocus(Grid),
create_menus(Parent, Opt),
Timer = observer_lib:start_timer(Timer0),
- {noreply, State#state{node=Node, tabs=Tabs, timer=Timer}};
+ {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt}};
handle_info(not_active, State = #state{timer = Timer0}) ->
Timer = observer_lib:stop_timer(Timer0),
{noreply, State#state{timer=Timer}};
-handle_info({error, Error}, State) ->
+handle_info({error, Error}, #state{opt=Opt}=State) ->
handle_error(Error),
- {noreply, State};
+ case Opt#opt.type of
+ mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true);
+ _ -> ok
+ end,
+ {noreply, State#state{opt=Opt#opt{type=ets}}};
handle_info(_Event, State) ->
{noreply, State}.
diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl
index 301bb4b32f..5732c12006 100644
--- a/lib/observer/src/observer_wx.erl
+++ b/lib/observer/src/observer_wx.erl
@@ -21,7 +21,7 @@
-behaviour(wx_object).
-export([start/0, stop/0]).
--export([create_menus/2, get_attrib/1, get_tracer/0, get_active_node/0,
+-export([create_menus/2, get_attrib/1, get_tracer/0, get_active_node/0, get_menubar/0,
set_status/1, create_txt_dialog/4, try_rpc/4, return_to_localnode/2]).
-export([init/1, handle_event/2, handle_cast/2, terminate/2, code_change/3,
@@ -94,6 +94,9 @@ get_tracer() ->
get_active_node() ->
wx_object:call(observer, get_active_node).
+get_menubar() ->
+ wx_object:call(observer, get_menubar).
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
init(_Args) ->
@@ -391,6 +394,9 @@ handle_call(get_tracer, _From, State=#state{trace_panel=TraceP}) ->
handle_call(get_active_node, _From, State=#state{node=Node}) ->
{reply, Node, State};
+handle_call(get_menubar, _From, State=#state{menubar=MenuBar}) ->
+ {reply, MenuBar, State};
+
handle_call(stop, From, State) ->
stop_servers(State),
{noreply, State#state{reply_to=From}};
diff --git a/lib/ssh/src/ssh.app.src b/lib/ssh/src/ssh.app.src
index 3245ba5197..76b7d8cd55 100644
--- a/lib/ssh/src/ssh.app.src
+++ b/lib/ssh/src/ssh.app.src
@@ -45,7 +45,7 @@
"erts-6.0",
"kernel-3.0",
"public_key-1.1",
- "stdlib-3.0"
+ "stdlib-3.1"
]}]}.
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index 0570853a9b..1d7be3547b 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -52,16 +52,15 @@
%% is temporary. see application(3)
%%--------------------------------------------------------------------
start() ->
- application:start(crypto),
- application:start(asn1),
- application:start(public_key),
- application:start(ssh).
+ start(temporary).
start(Type) ->
- application:start(crypto, Type),
- application:start(asn1),
- application:start(public_key, Type),
- application:start(ssh, Type).
+ case application:ensure_all_started(ssh, Type) of
+ {ok, _} ->
+ ok;
+ Other ->
+ Other
+ end.
%%--------------------------------------------------------------------
-spec stop() -> ok | {error, term()}.
@@ -90,7 +89,7 @@ connect(Socket, Options, Timeout) when is_port(Socket) ->
{error, Error};
{_SocketOptions, SshOptions} ->
case valid_socket_to_use(Socket, Options) of
- ok ->
+ ok ->
{ok, {Host,_Port}} = inet:sockname(Socket),
Opts = [{user_pid,self()}, {host,fmt_host(Host)} | SshOptions],
ssh_connection_handler:start_connection(client, Socket, Opts, Timeout);
@@ -128,23 +127,23 @@ connect(Host, Port, Options, Timeout) ->
-spec close(pid()) -> ok.
%%
%% Description: Closes an ssh connection.
-%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
close(ConnectionRef) ->
ssh_connection_handler:stop(ConnectionRef).
%%--------------------------------------------------------------------
-spec connection_info(pid(), [atom()]) -> [{atom(), term()}].
%%
-%% Description: Retrieves information about a connection.
-%%--------------------------------------------------------------------
+%% Description: Retrieves information about a connection.
+%%--------------------------------------------------------------------
connection_info(ConnectionRef, Options) ->
ssh_connection_handler:connection_info(ConnectionRef, Options).
%%--------------------------------------------------------------------
-spec channel_info(pid(), channel_id(), [atom()]) -> [{atom(), term()}].
%%
-%% Description: Retrieves information about a connection.
-%%--------------------------------------------------------------------
+%% Description: Retrieves information about a connection.
+%%--------------------------------------------------------------------
channel_info(ConnectionRef, ChannelId, Options) ->
ssh_connection_handler:channel_info(ConnectionRef, ChannelId, Options).
@@ -153,9 +152,9 @@ channel_info(ConnectionRef, ChannelId, Options) ->
-spec daemon(integer()|port(), proplists:proplist()) -> {ok, pid()} | {error, term()}.
-spec daemon(any | inet:ip_address(), integer(), proplists:proplist()) -> {ok, pid()} | {error, term()}.
-%% Description: Starts a server listening for SSH connections
+%% Description: Starts a server listening for SSH connections
%% on the given port.
-%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
daemon(Port) ->
daemon(Port, []).
@@ -188,9 +187,9 @@ daemon_info(Pid) ->
-spec stop_listener(pid()) -> ok.
-spec stop_listener(inet:ip_address(), integer()) -> ok.
%%
-%% Description: Stops the listener, but leaves
+%% Description: Stops the listener, but leaves
%% existing connections started by the listener up and running.
-%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
stop_listener(SysSup) ->
ssh_system_sup:stop_listener(SysSup).
stop_listener(Address, Port) ->
@@ -202,9 +201,9 @@ stop_listener(Address, Port, Profile) ->
-spec stop_daemon(pid()) -> ok.
-spec stop_daemon(inet:ip_address(), integer()) -> ok.
%%
-%% Description: Stops the listener and all connections started by
+%% Description: Stops the listener and all connections started by
%% the listener.
-%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
stop_daemon(SysSup) ->
ssh_system_sup:stop_system(SysSup).
stop_daemon(Address, Port) ->
@@ -243,7 +242,7 @@ start_shell({ok, ConnectionRef}) ->
case ssh_connection:session_channel(ConnectionRef, infinity) of
{ok,ChannelId} ->
success = ssh_connection:ptty_alloc(ConnectionRef, ChannelId, []),
- Args = [{channel_cb, ssh_shell},
+ Args = [{channel_cb, ssh_shell},
{init_args,[ConnectionRef, ChannelId]},
{cm, ConnectionRef}, {channel_id, ChannelId}],
{ok, State} = ssh_channel:init([Args]),
@@ -256,7 +255,7 @@ start_shell(Error) ->
%%--------------------------------------------------------------------
%%--------------------------------------------------------------------
-default_algorithms() ->
+default_algorithms() ->
ssh_transport:default_algorithms().
%%--------------------------------------------------------------------
@@ -296,13 +295,13 @@ daemon_shell_opt(Options) ->
daemon_host_inet_opt(HostAddr, Options1) ->
case HostAddr of
any ->
- {ok, Host0} = inet:gethostname(),
+ {ok, Host0} = inet:gethostname(),
{Host0, proplists:get_value(inet, Options1, inet), Options1};
{_,_,_,_} ->
- {HostAddr, inet,
+ {HostAddr, inet,
[{ip, HostAddr} | Options1]};
{_,_,_,_,_,_,_,_} ->
- {HostAddr, inet6,
+ {HostAddr, inet6,
[{ip, HostAddr} | Options1]}
end.
@@ -313,8 +312,8 @@ start_daemon(Socket, Options) ->
{error, Error};
{SocketOptions, SshOptions} ->
case valid_socket_to_use(Socket, Options) of
- ok ->
- try
+ ok ->
+ try
do_start_daemon(Socket, [{role,server}|SshOptions], SocketOptions)
catch
throw:bad_fd -> {error,bad_fd};
@@ -330,16 +329,16 @@ start_daemon(Host, Port, Options, Inet) ->
{error, _Reason} = Error ->
Error;
{SocketOptions, SshOptions}->
- try
+ try
do_start_daemon(Host, Port, [{role,server}|SshOptions] , [Inet|SocketOptions])
catch
throw:bad_fd -> {error,bad_fd};
_C:_E -> {error,{cannot_start_daemon,_C,_E}}
end
end.
-
+
do_start_daemon(Socket, SshOptions, SocketOptions) ->
- {ok, {IP,Port}} =
+ {ok, {IP,Port}} =
try {ok,_} = inet:sockname(Socket)
catch
_:_ -> throw(bad_socket)
@@ -351,7 +350,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
{address, Host},
{port, Port},
{role, server},
- {socket_opts, SocketOptions},
+ {socket_opts, SocketOptions},
{ssh_opts, SshOptions}],
{_, Callback, _} = proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}),
case ssh_system_sup:system_supervisor(Host, Port, Profile) of
@@ -385,7 +384,7 @@ do_start_daemon(Socket, SshOptions, SocketOptions) ->
end.
do_start_daemon(Host0, Port0, SshOptions, SocketOptions) ->
- {Host,Port1} =
+ {Host,Port1} =
try
case proplists:get_value(fd, SocketOptions) of
undefined ->
@@ -402,21 +401,21 @@ do_start_daemon(Host0, Port0, SshOptions, SocketOptions) ->
{Port, WaitRequestControl, Opts0} =
case Port1 of
0 -> %% Allocate the socket here to get the port number...
- {_, Callback, _} =
+ {_, Callback, _} =
proplists:get_value(transport, SshOptions, {tcp, gen_tcp, tcp_closed}),
{ok,LSock} = ssh_acceptor:callback_listen(Callback, 0, SocketOptions),
{ok,{_,LPort}} = inet:sockname(LSock),
- {LPort,
- {LSock,Callback},
+ {LPort,
+ {LSock,Callback},
[{lsocket,LSock},{lsock_owner,self()}]
};
_ ->
{Port1, false, []}
end,
- Opts = [{address, Host},
+ Opts = [{address, Host},
{port, Port},
{role, server},
- {socket_opts, SocketOptions},
+ {socket_opts, SocketOptions},
{ssh_opts, SshOptions} | Opts0],
case ssh_system_sup:system_supervisor(Host, Port, Profile) of
undefined ->
@@ -465,7 +464,7 @@ find_hostport(Fd) ->
{ok, HostPort} = inet:sockname(S),
ok = inet:close(S),
HostPort.
-
+
handle_options(Opts) ->
try handle_option(algs_compatibility(proplists:unfold(Opts)), [], []) of
@@ -480,9 +479,9 @@ handle_options(Opts) ->
algs_compatibility(Os0) ->
%% Take care of old options 'public_key_alg' and 'pref_public_key_algs'
case proplists:get_value(public_key_alg, Os0) of
- undefined ->
+ undefined ->
Os0;
- A when is_atom(A) ->
+ A when is_atom(A) ->
%% Skip public_key_alg if pref_public_key_algs is defined:
Os = lists:keydelete(public_key_alg, 1, Os0),
case proplists:get_value(pref_public_key_algs,Os) of
@@ -492,7 +491,7 @@ algs_compatibility(Os0) ->
[{pref_public_key_algs,['ssh-dss','ssh-rsa']} | Os];
undefined ->
throw({error, {eoptions, {public_key_alg,A} }});
- _ ->
+ _ ->
Os
end;
V ->
@@ -620,7 +619,7 @@ handle_ssh_option({silently_accept_hosts, Value} = Opt) when is_boolean(Value) -
Opt;
handle_ssh_option({user_interaction, Value} = Opt) when is_boolean(Value) ->
Opt;
-handle_ssh_option({preferred_algorithms,[_|_]} = Opt) ->
+handle_ssh_option({preferred_algorithms,[_|_]} = Opt) ->
handle_pref_algs(Opt);
handle_ssh_option({dh_gex_groups,L0}) when is_list(L0) ->
@@ -629,7 +628,7 @@ handle_ssh_option({dh_gex_groups,L0}) when is_list(L0) ->
lists:foldl(
fun({N,G,P}, Acc) when is_integer(N),N>0,
is_integer(G),G>0,
- is_integer(P),P>0 ->
+ is_integer(P),P>0 ->
[{N,{G,P}} | Acc];
({N,{G,P}}, Acc) when is_integer(N),N>0,
is_integer(G),G>0,
@@ -637,7 +636,7 @@ handle_ssh_option({dh_gex_groups,L0}) when is_list(L0) ->
[{N,{G,P}} | Acc];
({N,GPs}, Acc) when is_list(GPs) ->
lists:foldr(fun({Gi,Pi}, Acci) when is_integer(Gi),Gi>0,
- is_integer(Pi),Pi>0 ->
+ is_integer(Pi),Pi>0 ->
[{N,{Gi,Pi}} | Acci]
end, Acc, GPs)
end, [], L0))};
@@ -647,7 +646,7 @@ handle_ssh_option({dh_gex_groups,{Tag,File=[C|_]}}=Opt) when is_integer(C), C>0,
Tag == ssh_moduli_file ->
{ok,GroupDefs} =
case Tag of
- file ->
+ file ->
file:consult(File);
ssh_moduli_file ->
case file:open(File,[read]) of
@@ -672,14 +671,14 @@ handle_ssh_option({dh_gex_groups,{Tag,File=[C|_]}}=Opt) when is_integer(C), C>0,
catch
_:_ ->
throw({error, {{eoptions, Opt}, "Bad format in file: "++File}})
- end;
-
+ end;
+
-handle_ssh_option({dh_gex_limits,{Min,Max}} = Opt) when is_integer(Min), Min>0,
+handle_ssh_option({dh_gex_limits,{Min,Max}} = Opt) when is_integer(Min), Min>0,
is_integer(Max), Max>=Min ->
%% Server
Opt;
-handle_ssh_option({dh_gex_limits,{Min,I,Max}} = Opt) when is_integer(Min), Min>0,
+handle_ssh_option({dh_gex_limits,{Min,I,Max}} = Opt) when is_integer(Min), Min>0,
is_integer(I), I>=Min,
is_integer(Max), Max>=I ->
%% Client
@@ -724,7 +723,7 @@ handle_ssh_option({keyboard_interact_fun, Value} = Opt) when is_function(Value,3
Opt;
handle_ssh_option({compression, Value} = Opt) when is_atom(Value) ->
Opt;
-handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module),
+handle_ssh_option({exec, {Module, Function, _}} = Opt) when is_atom(Module),
is_atom(Function) ->
Opt;
handle_ssh_option({exec, Function} = Opt) when is_function(Function) ->
@@ -772,7 +771,7 @@ handle_ssh_option({quiet_mode, Value} = Opt) when is_boolean(Value) ->
Opt;
handle_ssh_option({idle_time, Value} = Opt) when is_integer(Value), Value > 0 ->
Opt;
-handle_ssh_option({rekey_limit, Value} = Opt) when is_integer(Value) ->
+handle_ssh_option({rekey_limit, Value} = Opt) when is_integer(Value) ->
Opt;
handle_ssh_option({id_string, random}) ->
{id_string, {random,2,5}}; %% 2 - 5 random characters
@@ -814,11 +813,11 @@ handle_pref_algs({preferred_algorithms,Algs}) ->
of
DefAlgs -> handle_pref_alg(Key,Vals,DefAlgs)
catch
- _:_ -> throw({error, {{eoptions, {preferred_algorithms,Key}},
+ _:_ -> throw({error, {{eoptions, {preferred_algorithms,Key}},
"Bad preferred_algorithms key"}})
end || {Key,Vals} <- Algs]
};
-
+
Dups ->
throw({error, {{eoptions, {preferred_algorithms,Dups}}, "Duplicates found"}})
catch
@@ -857,13 +856,13 @@ handle_pref_alg(Key,
) ->
handle_pref_alg(Key, lists:reverse(Vs), Sup);
-handle_pref_alg(Key,
+handle_pref_alg(Key,
Vs=[V|_],
Sup=[{client2server,_},{server2client,_}]
) when is_atom(V) ->
handle_pref_alg(Key, [{client2server,Vs},{server2client,Vs}], Sup);
-handle_pref_alg(Key,
+handle_pref_alg(Key,
Vs=[V|_],
Sup=[S|_]
) when is_atom(V), is_atom(S) ->
@@ -878,14 +877,14 @@ chk_alg_vs(OptKey, Values, SupportedValues) ->
[] -> Values;
Bad -> throw({error, {{eoptions, {OptKey,Bad}}, "Unsupported value(s) found"}})
end.
-
+
handle_ip(Inet) -> %% Default to ipv4
case lists:member(inet, Inet) of
true ->
Inet;
false ->
case lists:member(inet6, Inet) of
- true ->
+ true ->
Inet;
false ->
[inet | Inet]
@@ -916,8 +915,8 @@ directory_exist_readable(Dir) ->
{error, Error} ->
{error, Error}
end.
-
-
+
+
collect_per_size(L) ->
lists:foldr(
@@ -948,7 +947,7 @@ read_moduli_file(D, I, Acc) ->
read_moduli_file(D, I+1, Acc)
end
end.
-
+
handle_user_pref_pubkey_algs([], Acc) ->
{true, lists:reverse(Acc)};
handle_user_pref_pubkey_algs([H|T], Acc) ->
@@ -963,7 +962,7 @@ handle_user_pref_pubkey_algs([H|T], Acc) ->
false
end.
-fmt_host({A,B,C,D}) ->
+fmt_host({A,B,C,D}) ->
lists:concat([A,".",B,".",C,".",D]);
-fmt_host(T={_,_,_,_,_,_,_,_}) ->
+fmt_host(T={_,_,_,_,_,_,_,_}) ->
lists:flatten(string:join([io_lib:format("~.16B",[A]) || A <- tuple_to_list(T)], ":")).
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index 868f3a9181..4cd91177f6 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -127,7 +127,7 @@
recv_sequence = 0,
keyex_key,
keyex_info,
- random_length_padding = 255, % From RFC 4253 section 6.
+ random_length_padding = 15, % From RFC 4253 section 6.
%% User auth
user,
diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl
index fb5e086656..1dcf5d0708 100644
--- a/lib/ssh/src/ssh_auth.erl
+++ b/lib/ssh/src/ssh_auth.erl
@@ -264,12 +264,23 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
SessionId,
#ssh{opts = Opts,
userauth_supported_methods = Methods} = Ssh) ->
- <<?BYTE(HaveSig), ?UINT32(ALen), BAlg:ALen/binary,
- ?UINT32(KLen), KeyBlob:KLen/binary, SigWLen/binary>> = Data,
- Alg = binary_to_list(BAlg),
+
+ <<?BYTE(HaveSig),
+ ?UINT32(ALen), BAlg:ALen/binary,
+ Rest/binary>> = Data,
+
+ {KeyBlob, SigWLen} =
+ case Rest of
+ <<?UINT32(KLen0), KeyBlob0:KLen0/binary, SigWLen0/binary>> ->
+ {KeyBlob0, SigWLen0};
+ <<>> ->
+ {<<>>, <<>>}
+ end,
+
case HaveSig of
?TRUE ->
- case verify_sig(SessionId, User, "ssh-connection", Alg,
+ case verify_sig(SessionId, User, "ssh-connection",
+ binary_to_list(BAlg),
KeyBlob, SigWLen, Opts) of
true ->
{authorized, User,
@@ -284,7 +295,7 @@ handle_userauth_request(#ssh_msg_userauth_request{user = User,
?FALSE ->
{not_authorized, {User, undefined},
ssh_transport:ssh_packet(
- #ssh_msg_userauth_pk_ok{algorithm_name = Alg,
+ #ssh_msg_userauth_pk_ok{algorithm_name = binary_to_list(BAlg),
key_blob = KeyBlob}, Ssh)}
end;
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index dcb6ff9343..2eb29c9b32 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -339,6 +339,7 @@ renegotiate_data(ConnectionHandler) ->
ssh_params :: #ssh{}
| undefined,
socket :: inet:socket(),
+ sender :: pid() | undefined,
decrypted_data_buffer = <<>> :: binary(),
encrypted_data_buffer = <<>> :: binary(),
undecrypted_packet_length :: undefined | non_neg_integer(),
@@ -367,9 +368,10 @@ init_connection_handler(Role, Socket, Opts) ->
{Protocol, Callback, CloseTag} =
proplists:get_value(transport, Opts, ?DefaultTransport),
S0#data{ssh_params = init_ssh_record(Role, Socket, Opts),
- transport_protocol = Protocol,
- transport_cb = Callback,
- transport_close_tag = CloseTag
+ sender = spawn_link(fun() -> nonblocking_sender(Socket, Callback) end),
+ transport_protocol = Protocol,
+ transport_cb = Callback,
+ transport_close_tag = CloseTag
}
of
S ->
@@ -525,7 +527,7 @@ handle_event(_, _Event, {init_error,Error}, _) ->
%% The very first event that is sent when the we are set as controlling process of Socket
handle_event(_, socket_control, {hello,_}, D) ->
VsnMsg = ssh_transport:hello_version_msg(string_version(D#data.ssh_params)),
- ok = send_bytes(VsnMsg, D),
+ send_bytes(VsnMsg, D),
case inet:getopts(Socket=D#data.socket, [recbuf]) of
{ok, [{recbuf,Size}]} ->
%% Set the socket to the hello text line handling mode:
@@ -550,7 +552,7 @@ handle_event(_, {info_line,_Line}, {hello,Role}, D) ->
server ->
%% But the client may NOT send them to the server. Openssh answers with cleartext,
%% and so do we
- ok = send_bytes("Protocol mismatch.", D),
+ send_bytes("Protocol mismatch.", D),
{stop, {shutdown,"Protocol mismatch in version exchange. Client sent info lines."}}
end;
@@ -565,7 +567,7 @@ handle_event(_, {version_exchange,Version}, {hello,Role}, D) ->
{active, once},
{recbuf, D#data.inet_initial_recbuf_size}]),
{KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(Ssh1),
- ok = send_bytes(SshPacket, D),
+ send_bytes(SshPacket, D),
{next_state, {kexinit,Role,init}, D#data{ssh_params = Ssh,
key_exchange_init_msg = KeyInitMsg}};
not_supported ->
@@ -583,7 +585,7 @@ handle_event(_, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg},
Ssh1 = ssh_transport:key_init(peer_role(Role), D#data.ssh_params, Payload),
Ssh = case ssh_transport:handle_kexinit_msg(Kex, OwnKex, Ssh1) of
{ok, NextKexMsg, Ssh2} when Role==client ->
- ok = send_bytes(NextKexMsg, D),
+ send_bytes(NextKexMsg, D),
Ssh2;
{ok, Ssh2} when Role==server ->
Ssh2
@@ -596,43 +598,43 @@ handle_event(_, {#ssh_msg_kexinit{}=Kex, Payload}, {kexinit,Role,ReNeg},
%%%---- diffie-hellman
handle_event(_, #ssh_msg_kexdh_init{} = Msg, {key_exchange,server,ReNeg}, D) ->
{ok, KexdhReply, Ssh1} = ssh_transport:handle_kexdh_init(Msg, D#data.ssh_params),
- ok = send_bytes(KexdhReply, D),
+ send_bytes(KexdhReply, D),
{ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kexdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) ->
{ok, NewKeys, Ssh} = ssh_transport:handle_kexdh_reply(Msg, D#data.ssh_params),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}};
%%%---- diffie-hellman group exchange
handle_event(_, #ssh_msg_kex_dh_gex_request{} = Msg, {key_exchange,server,ReNeg}, D) ->
{ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
- ok = send_bytes(GexGroup, D),
+ send_bytes(GexGroup, D),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_request_old{} = Msg, {key_exchange,server,ReNeg}, D) ->
{ok, GexGroup, Ssh} = ssh_transport:handle_kex_dh_gex_request(Msg, D#data.ssh_params),
- ok = send_bytes(GexGroup, D),
+ send_bytes(GexGroup, D),
{next_state, {key_exchange_dh_gex_init,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_dh_gex_group{} = Msg, {key_exchange,client,ReNeg}, D) ->
{ok, KexGexInit, Ssh} = ssh_transport:handle_kex_dh_gex_group(Msg, D#data.ssh_params),
- ok = send_bytes(KexGexInit, D),
+ send_bytes(KexGexInit, D),
{next_state, {key_exchange_dh_gex_reply,client,ReNeg}, D#data{ssh_params=Ssh}};
%%%---- elliptic curve diffie-hellman
handle_event(_, #ssh_msg_kex_ecdh_init{} = Msg, {key_exchange,server,ReNeg}, D) ->
{ok, KexEcdhReply, Ssh1} = ssh_transport:handle_kex_ecdh_init(Msg, D#data.ssh_params),
- ok = send_bytes(KexEcdhReply, D),
+ send_bytes(KexEcdhReply, D),
{ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}};
handle_event(_, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D) ->
{ok, NewKeys, Ssh} = ssh_transport:handle_kex_ecdh_reply(Msg, D#data.ssh_params),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh}};
@@ -640,9 +642,9 @@ handle_event(_, #ssh_msg_kex_ecdh_reply{} = Msg, {key_exchange,client,ReNeg}, D)
handle_event(_, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,server,ReNeg}, D) ->
{ok, KexGexReply, Ssh1} = ssh_transport:handle_kex_dh_gex_init(Msg, D#data.ssh_params),
- ok = send_bytes(KexGexReply, D),
+ send_bytes(KexGexReply, D),
{ok, NewKeys, Ssh} = ssh_transport:new_keys_message(Ssh1),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,server,ReNeg}, D#data{ssh_params=Ssh}};
@@ -650,7 +652,7 @@ handle_event(_, #ssh_msg_kex_dh_gex_init{} = Msg, {key_exchange_dh_gex_init,serv
handle_event(_, #ssh_msg_kex_dh_gex_reply{} = Msg, {key_exchange_dh_gex_reply,client,ReNeg}, D) ->
{ok, NewKeys, Ssh1} = ssh_transport:handle_kex_dh_gex_reply(Msg, D#data.ssh_params),
- ok = send_bytes(NewKeys, D),
+ send_bytes(NewKeys, D),
{next_state, {new_keys,client,ReNeg}, D#data{ssh_params=Ssh1}};
@@ -662,7 +664,7 @@ handle_event(_, #ssh_msg_newkeys{} = Msg, {new_keys,Role,init}, D) ->
Ssh = case Role of
client ->
{MsgReq, Ssh2} = ssh_auth:service_request_msg(Ssh1),
- ok = send_bytes(MsgReq, D),
+ send_bytes(MsgReq, D),
Ssh2;
server ->
Ssh1
@@ -680,7 +682,7 @@ handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {s
"ssh-userauth" ->
Ssh0 = #ssh{session_id=SessionId} = D#data.ssh_params,
{ok, {Reply, Ssh}} = ssh_auth:handle_userauth_request(Msg, SessionId, Ssh0),
- ok = send_bytes(Reply, D),
+ send_bytes(Reply, D),
{next_state, {userauth,server}, D#data{ssh_params = Ssh}};
_ ->
@@ -692,7 +694,7 @@ handle_event(_, Msg = #ssh_msg_service_request{name=ServiceName}, StateName = {s
handle_event(_, #ssh_msg_service_accept{name = "ssh-userauth"}, {service_request,client},
#data{ssh_params = #ssh{service="ssh-userauth"} = Ssh0} = State) ->
{Msg, Ssh} = ssh_auth:init_userauth_request_msg(Ssh0),
- ok = send_bytes(Msg, State),
+ send_bytes(Msg, State),
{next_state, {userauth,client}, State#data{auth_user = Ssh#ssh.user, ssh_params = Ssh}};
@@ -709,7 +711,7 @@ handle_event(_,
%% Probably the very first userauth_request but we deny unauthorized login
{not_authorized, _, {Reply,Ssh}} =
ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0),
- ok = send_bytes(Reply, D),
+ send_bytes(Reply, D),
{keep_state, D#data{ssh_params = Ssh}};
{"ssh-connection", "ssh-connection", Method} ->
@@ -719,7 +721,7 @@ handle_event(_,
%% Yepp! we support this method
case ssh_auth:handle_userauth_request(Msg, Ssh0#ssh.session_id, Ssh0) of
{authorized, User, {Reply, Ssh}} ->
- ok = send_bytes(Reply, D),
+ send_bytes(Reply, D),
D#data.starter ! ssh_connected,
connected_fun(User, Method, D),
{next_state, {connected,server},
@@ -727,11 +729,11 @@ handle_event(_,
ssh_params = Ssh#ssh{authenticated = true}}};
{not_authorized, {User, Reason}, {Reply, Ssh}} when Method == "keyboard-interactive" ->
retry_fun(User, Reason, D),
- ok = send_bytes(Reply, D),
+ send_bytes(Reply, D),
{next_state, {userauth_keyboard_interactive,server}, D#data{ssh_params = Ssh}};
{not_authorized, {User, Reason}, {Reply, Ssh}} ->
retry_fun(User, Reason, D),
- ok = send_bytes(Reply, D),
+ send_bytes(Reply, D),
{keep_state, D#data{ssh_params = Ssh}}
end;
false ->
@@ -1430,18 +1432,15 @@ start_the_connection_child(UserPid, Role, Socket, Options) ->
%% Stopping
-type finalize_termination_result() :: ok .
-finalize_termination(_StateName, #data{transport_cb = Transport,
- connection_state = Connection,
- socket = Socket}) ->
- case Connection of
+finalize_termination(_StateName, D) ->
+ case D#data.connection_state of
#connection{system_supervisor = SysSup,
sub_system_supervisor = SubSysSup} when is_pid(SubSysSup) ->
ssh_system_sup:stop_subsystem(SysSup, SubSysSup);
_ ->
do_nothing
end,
- (catch Transport:close(Socket)),
- ok.
+ close_transport(D).
%%--------------------------------------------------------------------
%% "Invert" the Role
@@ -1496,8 +1495,33 @@ send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) ->
send_bytes(Bytes, State),
State#data{ssh_params=Ssh}.
-send_bytes(Bytes, #data{socket = Socket, transport_cb = Transport}) ->
- Transport:send(Socket, Bytes).
+send_bytes(Bytes, #data{sender = Sender}) ->
+ Sender ! {send,Bytes},
+ ok.
+
+close_transport(D) ->
+ D#data.sender ! close,
+ ok.
+
+
+nonblocking_sender(Socket, Callback) ->
+ receive
+ {send, Bytes} ->
+ case Callback:send(Socket, Bytes) of
+ ok ->
+ nonblocking_sender(Socket, Callback);
+ E = {error,_} ->
+ exit({shutdown,E})
+ end;
+
+ close ->
+ case Callback:close(Socket) of
+ ok ->
+ ok;
+ E = {error,_} ->
+ exit({shutdown,E})
+ end
+ end.
handle_version({2, 0} = NumVsn, StrVsn, Ssh0) ->
Ssh = counterpart_versions(NumVsn, StrVsn, Ssh0),
diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl
index 0f68130a05..8b2db0e1a8 100644
--- a/lib/ssh/test/ssh_algorithms_SUITE.erl
+++ b/lib/ssh/test/ssh_algorithms_SUITE.erl
@@ -180,21 +180,19 @@ simple_exec(Config) ->
%%--------------------------------------------------------------------
%% Testing if no group matches
simple_exec_groups_no_match_too_small(Config) ->
- try simple_exec_group({400,500,600}, Config)
- of
- _ -> ct:fail("Exec though no group available")
- catch
- error:{badmatch,{error,"No possible diffie-hellman-group-exchange group found"}} ->
- ok
- end.
+ try_exec_simple_group({400,500,600}, Config).
simple_exec_groups_no_match_too_large(Config) ->
- try simple_exec_group({9200,9500,9700}, Config)
+ try_exec_simple_group({9200,9500,9700}, Config).
+
+
+try_exec_simple_group(Group, Config) ->
+ try simple_exec_group(Group, Config)
of
_ -> ct:fail("Exec though no group available")
catch
- error:{badmatch,{error,"No possible diffie-hellman-group-exchange group found"}} ->
- ok
+ error:{badmatch,{error,"No possible diffie-hellman-group-exchange group found"}} -> ok;
+ error:{badmatch,{error,"Connection closed"}} -> ok
end.
%%--------------------------------------------------------------------
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 575c1af3a9..212b99c695 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.3.1
+SSH_VSN = 4.3.2
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src
index b26efbd88f..00b0513891 100644
--- a/lib/ssl/src/ssl.app.src
+++ b/lib/ssl/src/ssl.app.src
@@ -55,7 +55,7 @@
{applications, [crypto, public_key, kernel, stdlib]},
{env, []},
{mod, {ssl_app, []}},
- {runtime_dependencies, ["stdlib-3.0","public_key-1.2","kernel-3.0",
+ {runtime_dependencies, ["stdlib-3.1","public_key-1.2","kernel-3.0",
"erts-7.0","crypto-3.3", "inets-5.10.7"]}]}.
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index fadc67ef80..22e24af0a8 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,24 +1,11 @@
%% -*- erlang -*-
{"%VSN%",
[
- {<<"^8[.]0$">>,
- [{load_module, ssl_handshake, soft_purge, soft_purge, []}
- ]},
- {<<"^7[.][^.].*">>, [{restart_application, ssl}]},
- {<<"6\\..*">>, [{restart_application, ssl}]},
- {<<"5\\..*">>, [{restart_application, ssl}]},
- {<<"4\\..*">>, [{restart_application, ssl}]},
- {<<"3\\..*">>, [{restart_application, ssl}]}
+ {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
+ {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
],
[
- {<<"^8[.]0$">>,
- [{load_module, ssl_handshake, soft_purge, soft_purge, []}
- ]},
- {<<"^7[.][^.].*">>, [{restart_application, ssl}]},
- {<<"6\\..*">>, [{restart_application, ssl}]},
- {<<"5\\..*">>, [{restart_application, ssl}]},
- {<<"4\\..*">>, [{restart_application, ssl}]},
- {<<"3\\..*">>, [{restart_application, ssl}]}
+ {<<"^8[.]0([.][0-9]+)?$">>, [{restart_application, ssl}]},
+ {<<"^[3-7][.][^.].*">>, [{restart_application, ssl}]}
]
}.
-
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index adee59393e..8a990870e8 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -824,8 +824,6 @@ handle_common_event(internal, #change_cipher_spec{type = <<1>>}, StateName,
#state{negotiated_version = Version} = State, Connection) ->
Connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE), Version,
StateName, State);
-handle_common_event(internal, _, _, _, _) ->
- {keep_state_and_data, [postpone]};
handle_common_event(_Type, Msg, StateName, #state{negotiated_version = Version} = State,
Connection) ->
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE),
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index eaf866c339..8b828f3421 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -214,7 +214,7 @@ init({call, From}, {start, Timeout},
{Record, State} = next_record(State1),
next_event(hello, Record, State);
init(Type, Event, State) ->
- ssl_connection:init(Type, Event, State, ?MODULE).
+ gen_handshake(ssl_connection, init, Type, Event, State).
%%--------------------------------------------------------------------
-spec error(gen_statem:event_type(),
@@ -258,13 +258,13 @@ hello(internal, #client_hello{client_version = ClientVersion,
_ -> Protocol0
end,
- ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt},
+ gen_handshake(ssl_connection, hello, internal, {common_client_hello, Type, ServerHelloExt},
State#state{connection_states = ConnectionStates,
negotiated_version = Version,
hashsign_algorithm = HashSign,
session = Session,
client_ecc = {EllipticCurves, EcPointFormats},
- negotiated_protocol = Protocol}, ?MODULE)
+ negotiated_protocol = Protocol})
end;
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
@@ -280,36 +280,36 @@ hello(internal, #server_hello{} = Hello,
Version, NewId, ConnectionStates, ProtoExt, Protocol, State)
end;
hello(info, Event, State) ->
- handle_info(Event, hello, State);
+ gen_info(Event, hello, State);
hello(Type, Event, State) ->
- ssl_connection:hello(Type, Event, State, ?MODULE).
+ gen_handshake(ssl_connection, hello, Type, Event, State).
%%--------------------------------------------------------------------
-spec abbreviated(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
abbreviated(info, Event, State) ->
- handle_info(Event, abbreviated, State);
+ gen_info(Event, abbreviated, State);
abbreviated(Type, Event, State) ->
- ssl_connection:abbreviated(Type, Event, State, ?MODULE).
+ gen_handshake(ssl_connection, abbreviated, Type, Event, State).
%%--------------------------------------------------------------------
-spec certify(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
certify(info, Event, State) ->
- handle_info(Event, certify, State);
+ gen_info(Event, certify, State);
certify(Type, Event, State) ->
- ssl_connection:certify(Type, Event, State, ?MODULE).
+ gen_handshake(ssl_connection, certify, Type, Event, State).
%%--------------------------------------------------------------------
-spec cipher(gen_statem:event_type(), term(), #state{}) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
cipher(info, Event, State) ->
- handle_info(Event, cipher, State);
+ gen_info(Event, cipher, State);
cipher(Type, Event, State) ->
- ssl_connection:cipher(Type, Event, State, ?MODULE).
+ gen_handshake(ssl_connection, cipher, Type, Event, State).
%%--------------------------------------------------------------------
-spec connection(gen_statem:event_type(),
@@ -317,7 +317,7 @@ cipher(Type, Event, State) ->
gen_statem:state_function_result().
%%--------------------------------------------------------------------
connection(info, Event, State) ->
- handle_info(Event, connection, State);
+ gen_info(Event, connection, State);
connection(internal, #hello_request{},
#state{role = client, host = Host, port = Port,
session = #session{own_certificate = Cert} = Session0,
@@ -433,11 +433,16 @@ handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Da
%%% TLS record protocol level Alert messages
handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
#state{negotiated_version = Version} = State) ->
- case decode_alerts(EncAlerts) of
+ try decode_alerts(EncAlerts) of
Alerts = [_|_] ->
handle_alerts(Alerts, {next_state, StateName, State});
+ [] ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert), Version, StateName, State);
#alert{} = Alert ->
handle_own_alert(Alert, Version, StateName, State)
+ catch
+ _:_ ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error), Version, StateName, State)
end;
%% Ignore unknown TLS record level protocol messages
handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
@@ -1040,3 +1045,31 @@ handle_sni_extension(#client_hello{extensions = HelloExtensions}, State0) ->
end;
handle_sni_extension(_, State) ->
State.
+
+gen_handshake(GenConnection, StateName, Type, Event, #state{negotiated_version = Version} = State) ->
+ try GenConnection:StateName(Type, Event, State, ?MODULE) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data), Version, StateName, State)
+ end.
+
+gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) ->
+ try handle_info(Event, StateName, State) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR, malformed_data), Version, StateName, State)
+ end;
+
+gen_info(Event, StateName, #state{negotiated_version = Version} = State) ->
+ try handle_info(Event, StateName, State) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data), Version, StateName, State)
+ end.
+
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index 566b7db332..6e593950d9 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -109,19 +109,25 @@ hello(#client_hello{client_version = ClientVersion,
cipher_suites = CipherSuites} = Hello,
#ssl_options{versions = Versions} = SslOpts,
Info, Renegotiation) ->
- Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions),
- case ssl_cipher:is_fallback(CipherSuites) of
+ try
+ Version = ssl_handshake:select_version(tls_record, ClientVersion, Versions),
+ case ssl_cipher:is_fallback(CipherSuites) of
true ->
- Highest = tls_record:highest_protocol_version(Versions),
- case tls_record:is_higher(Highest, Version) of
- true ->
- ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK);
- false ->
- handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation)
- end;
- false ->
- handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation)
- end.
+ Highest = tls_record:highest_protocol_version(Versions),
+ case tls_record:is_higher(Highest, Version) of
+ true ->
+ ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK);
+ false ->
+ handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation)
+ end;
+ false ->
+ handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation)
+ end
+ catch
+ _:_ ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data)
+ end.
+
%%--------------------------------------------------------------------
-spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist().
%%
@@ -187,8 +193,13 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId,
get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
Body:Length/binary,Rest/binary>>, #ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
Raw = <<?BYTE(Type), ?UINT24(Length), Body/binary>>,
- Handshake = decode_handshake(Version, Type, Body, V2Hello),
- get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc]);
+ try decode_handshake(Version, Type, Body, V2Hello) of
+ Handshake ->
+ get_tls_handshake_aux(Version, Rest, Opts, [{Handshake,Raw} | Acc])
+ catch
+ _:_ ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, handshake_decode_error))
+ end;
get_tls_handshake_aux(_Version, Data, _, Acc) ->
{lists:reverse(Acc), Data}.
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index 665dbb1df3..38341f77aa 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -340,7 +340,7 @@ init_per_testcase(TestCase, Config) when TestCase == client_renegotiate;
TestCase == renegotiate_dos_mitigate_passive;
TestCase == renegotiate_dos_mitigate_absolute ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
- ct:timetrap({seconds, 30}),
+ ct:timetrap({seconds, 90}),
Config;
init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
@@ -350,6 +350,11 @@ init_per_testcase(TestCase, Config) when TestCase == psk_cipher_suites;
TestCase == ciphers_dsa_signed_certs;
TestCase == ciphers_dsa_signed_certs_openssl_names;
TestCase == anonymous_cipher_suites;
+ TestCase == ciphers_ecdsa_signed_certs;
+ TestCase == ciphers_ecdsa_signed_certs_openssl_names;
+ TestCase == anonymous_cipher_suites;
+ TestCase == psk_anon_cipher_suites;
+ TestCase == psk_anon_with_hint_cipher_suites;
TestCase == versions_option,
TestCase == tls_tcp_connect_big ->
ssl_test_lib:ct_log_supported_protocol_versions(Config),
diff --git a/lib/ssl/test/ssl_crl_SUITE.erl b/lib/ssl/test/ssl_crl_SUITE.erl
index 00636e5660..e37e127440 100644
--- a/lib/ssl/test/ssl_crl_SUITE.erl
+++ b/lib/ssl/test/ssl_crl_SUITE.erl
@@ -72,7 +72,7 @@ init_per_suite(Config) ->
false ->
{skip, io_lib:format("Bad openssl version: ~p",[OpenSSL_version])};
_ ->
- catch crypto:stop(),
+ end_per_suite(Config),
try crypto:start() of
ok ->
{ok, Hostname0} = inet:gethostname(),
diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl
index e49d432c21..17237118a0 100644
--- a/lib/ssl/test/ssl_packet_SUITE.erl
+++ b/lib/ssl/test/ssl_packet_SUITE.erl
@@ -41,7 +41,7 @@
-define(MANY, 1000).
-define(SOME, 50).
--define(BASE_TIMEOUT_SECONDS, 15).
+-define(BASE_TIMEOUT_SECONDS, 30).
-define(SOME_SCALE, 20).
-define(MANY_SCALE, 20).
@@ -140,6 +140,7 @@ init_per_suite(Config) ->
catch crypto:stop(),
try crypto:start() of
ok ->
+ ssl:stop(),
ssl:start(),
{ok, _} = make_certs:all(proplists:get_value(data_dir, Config),
proplists:get_value(priv_dir, Config)),
@@ -162,6 +163,7 @@ init_per_group(GroupName, Config) ->
{skip, "Missing crypto support"}
end;
_ ->
+ ssl:stop(),
ssl:start(),
Config
end.
diff --git a/lib/ssl/test/ssl_payload_SUITE.erl b/lib/ssl/test/ssl_payload_SUITE.erl
index cb0571d0a7..c0b762760d 100644
--- a/lib/ssl/test/ssl_payload_SUITE.erl
+++ b/lib/ssl/test/ssl_payload_SUITE.erl
@@ -104,8 +104,13 @@ init_per_testcase(TestCase, Config) when TestCase == server_echos_passive_huge;
TestCase == client_echos_passive_huge;
TestCase == client_echos_active_once_huge;
TestCase == client_echos_active_huge ->
- ct:timetrap({seconds, 90}),
- Config;
+ case erlang:system_info(system_architecture) of
+ "sparc-sun-solaris2.10" ->
+ {skip,"Will take to long time on an old Sparc"};
+ _ ->
+ ct:timetrap({seconds, 90}),
+ Config
+ end;
init_per_testcase(TestCase, Config) when TestCase == server_echos_passive_big;
TestCase == server_echos_active_once_big;
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index b3109b5de9..83a4dae0a1 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -116,6 +116,7 @@ init_per_suite(Config0) ->
catch crypto:stop(),
try crypto:start() of
ok ->
+ ssl:stop(),
ssl:start(),
{ok, _} = make_certs:all(proplists:get_value(data_dir, Config0),
proplists:get_value(priv_dir, Config0)),
@@ -1264,7 +1265,7 @@ client_check_result(Port, DataExpected, DataReceived) ->
_ ->
client_check_result(Port, DataExpected, NewData)
end
- after 3000 ->
+ after 20000 ->
ct:fail({"Time out on openSSL Client", {expected, DataExpected},
{got, DataReceived}})
end.
diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl
index 113b3b4158..f6af1e6182 100644
--- a/lib/ssl/test/ssl_upgrade_SUITE.erl
+++ b/lib/ssl/test/ssl_upgrade_SUITE.erl
@@ -29,7 +29,8 @@
server,
client,
soft,
- result_proxy
+ result_proxy,
+ skip
}).
all() ->
@@ -73,8 +74,15 @@ major_upgrade(Config) when is_list(Config) ->
minor_upgrade(Config) when is_list(Config) ->
ct_release_test:upgrade(ssl, minor,{?MODULE, #state{config = Config}}, Config).
-upgrade_init(CTData, #state{config = Config} = State) ->
- {ok, {_, _, Up, _Down}} = ct_release_test:get_appup(CTData, ssl),
+upgrade_init(CtData, State) ->
+ {ok,{FromVsn,ToVsn}} = ct_release_test:get_app_vsns(CtData, ssl),
+ upgrade_init(FromVsn, ToVsn, CtData, State).
+
+upgrade_init(_, "8.0.2", _, State) ->
+ %% Requires stdlib upgrade so it will be a node upgrade!
+ State#state{skip = true};
+upgrade_init(_, _, CtData, #state{config = Config} = State) ->
+ {ok, {_, _, Up, _Down}} = ct_release_test:get_appup(CtData, ssl),
ct:pal("Up: ~p", [Up]),
Soft = is_soft(Up), %% It is symmetrical, if upgrade is soft so is downgrade
Pid = spawn(?MODULE, result_proxy_init, [[]]),
@@ -88,6 +96,8 @@ upgrade_init(CTData, #state{config = Config} = State) ->
State#state{soft = Soft, result_proxy = Pid}
end.
+upgrade_upgraded(_, #state{skip = true} = State) ->
+ State;
upgrade_upgraded(_, #state{soft = false, config = Config, result_proxy = Pid} = State) ->
ct:pal("Restart upgrade ~n", []),
{Server, Client} = restart_start_connection(Config, Pid),
@@ -96,7 +106,6 @@ upgrade_upgraded(_, #state{soft = false, config = Config, result_proxy = Pid} =
ssl_test_lib:close(Client),
ok = Result,
State;
-
upgrade_upgraded(_, #state{server = Server0, client = Client0,
config = Config, soft = true,
result_proxy = Pid} = State) ->
@@ -110,6 +119,8 @@ upgrade_upgraded(_, #state{server = Server0, client = Client0,
{Server, Client} = soft_start_connection(Config, Pid),
State#state{server = Server, client = Client}.
+upgrade_downgraded(_, #state{skip = true} = State) ->
+ State;
upgrade_downgraded(_, #state{soft = false, config = Config, result_proxy = Pid} = State) ->
ct:pal("Restart downgrade: ~n", []),
{Server, Client} = restart_start_connection(Config, Pid),
@@ -119,7 +130,6 @@ upgrade_downgraded(_, #state{soft = false, config = Config, result_proxy = Pid}
Pid ! stop,
ok = Result,
State;
-
upgrade_downgraded(_, #state{server = Server, client = Client, soft = true, result_proxy = Pid} = State) ->
ct:pal("Soft downgrade: ~n", []),
Server ! changed_version,
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 6afac59109..914eb43505 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 8.0.1
+SSL_VSN = 8.0.2
diff --git a/lib/stdlib/doc/src/queue.xml b/lib/stdlib/doc/src/queue.xml
index a46ca47033..9f3aff03a3 100644
--- a/lib/stdlib/doc/src/queue.xml
+++ b/lib/stdlib/doc/src/queue.xml
@@ -401,7 +401,7 @@
</func>
<func>
- <name name="liat" arity="1"/>v
+ <name name="liat" arity="1"/>
<fsummary>Remove the tail item from a queue.</fsummary>
<desc>
<p>Returns a queue <c><anno>Q2</anno></c> that is the result of removing
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index fe9df601eb..d7ee5c1f5d 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -55,7 +55,7 @@
-type beam() :: module() | file:filename() | binary().
--type forms() :: [erl_parse:abstract_form()].
+-type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()].
-type abst_code() :: {AbstVersion :: atom(), forms()} | 'no_abstract_code'.
-type dataB() :: binary().
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index 41037b8f53..c74343d9ca 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1 +1 @@
-STDLIB_VSN = 3.0.1
+STDLIB_VSN = 3.1
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
index 9a146632c5..ba6190d194 100644
--- a/lib/tools/emacs/erlang-test.el
+++ b/lib/tools/emacs/erlang-test.el
@@ -52,28 +52,42 @@ 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))
- ;; 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)))))
+ (erlang-file (expand-file-name "erlang_test.erl" dir))
+ (tags-file (expand-file-name "TAGS" dir))
+ (old-tags-file-name (default-value 'tags-file-name))
+ (old-tags-table-list (default-value 'tags-table-list))
+ tags-file-name
+ tags-table-list
+ tags-table-set-list
+ erlang-buffer
+ erlang-mode-hook
+ prog-mode-hook
+ erlang-shell-mode-hook
+ tags-add-tables)
+ (unwind-protect
+ (progn
+ (setq-default tags-file-name nil)
+ (setq-default tags-table-list nil)
+ (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-complete-at-point 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))
+ (setq-default tags-file-name old-tags-file-name)
+ (setq-default tags-table-list old-tags-table-list))))
(defun erlang-test-create-erlang-file (erlang-file)
(with-temp-file erlang-file
@@ -116,6 +130,54 @@ concatenated to form an erlang file to test on.")
(should (eq expected-line (line-number-at-pos)))
(should (= (point-at-bol) (point))))
+(defun erlang-test-complete-at-point (tags-file)
+ (with-temp-buffer
+ (erlang-mode)
+ (setq-local tags-file-name tags-file)
+ (insert "\nerlang_test:fun")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:function"))
+ (insert "\nfun")
+ (erlang-complete-tag)
+ (should (looking-back "function"))
+ (insert "\nerlang_")
+ (erlang-complete-tag)
+ (should (looking-back "erlang_test:"))))
+
+
+(ert-deftest erlang-test-compile-options ()
+ (erlang-test-format-opt t
+ "t")
+ (erlang-test-format-opt nil
+ "nil")
+ (erlang-test-format-opt (cons 1 2)
+ "{1, 2}")
+ (erlang-test-format-opt (list 1)
+ "[1]")
+ (erlang-test-format-opt (list 1 2)
+ "[1, 2]")
+ (erlang-test-format-opt (list 1 2 3)
+ "[1, 2, 3]")
+ (erlang-test-format-opt 'symbol
+ "symbol")
+ (erlang-test-format-opt "string"
+ "\"string\"")
+ (erlang-test-format-opt []
+ "{}")
+ (erlang-test-format-opt [1]
+ "{1}")
+ (erlang-test-format-opt [1 2]
+ "{1, 2}")
+ (erlang-test-format-opt [1 2 (3 [4 5 6] 7)]
+ "{1, 2, [3, {4, 5, 6}, 7]}"))
+
+(defun erlang-test-format-opt (elisp &optional expected-erlang)
+ (let ((erlang (inferior-erlang-format-opt elisp)))
+ (message "%s -> %s" elisp erlang)
+ (when expected-erlang
+ (should (equal erlang expected-erlang)))
+ erlang))
+
(provide 'erlang-test)
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index a2062180f3..73c6b8d768 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1436,8 +1436,6 @@ Other commands:
(erlang-skel-init)
(when (fboundp 'tempo-use-tag-list)
(tempo-use-tag-list 'erlang-tempo-tags))
- (when (boundp 'xref-backend-functions)
- (add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t))
(run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)))
@@ -1548,9 +1546,7 @@ 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)
- (set (make-local-variable 'find-tag-default-function)
- 'erlang-find-tag-for-completion))
+ 'erlang-current-defun))
(defun erlang-font-lock-init ()
"Initialize Font Lock for Erlang mode."
@@ -3233,18 +3229,16 @@ With argument, do this that many times."
(interactive "p")
(or arg (setq arg 1))
(while (and (looking-at "[ \t]*[%\n]")
- (zerop (forward-line 1))))
+ (zerop (forward-line 1))))
;; Move to the next clause.
(erlang-beginning-of-clause (- arg))
(beginning-of-line);; Just to be sure...
(let ((continue t))
(while (and (not (bobp)) continue)
(forward-line -1)
- (skip-chars-forward " \t")
- (if (looking-at "[%\n]")
- nil
- (end-of-line)
- (setq continue nil)))))
+ (unless (looking-at "[ \t]*[%\n]")
+ (end-of-line)
+ (setq continue nil)))))
(defun erlang-mark-clause ()
"Put mark at end of clause, point at beginning."
@@ -4352,11 +4346,6 @@ as on the old form `tag'.
In the completion list, `module:tag' and `module:' shows up.
-Call this function from an appropriate init file, or add it to
-Erlang mode hook with the commands:
- (add-hook 'erlang-mode-hook 'erlang-tags-init)
- (add-hook 'erlang-shell-mode-hook 'erlang-tags-init)
-
This function only works under Emacs 18 and Emacs 19. Currently, It
is not implemented under XEmacs. (Hint: The Emacs 19 etags module
works under XEmacs.)"
@@ -4367,11 +4356,16 @@ works under XEmacs.)"
(setq erlang-tags-installed t))
(t
(require 'etags)
- ;; Test on a function available in the Emacs 19 version
- ;; of tags but not in the XEmacs version.
- (when (fboundp 'find-tag-noselect)
- (erlang-tags-define-keys (current-local-map))
- (setq erlang-tags-installed t)))))
+ (set (make-local-variable 'find-tag-default-function)
+ 'erlang-find-tag-for-completion)
+ (if (>= emacs-major-version 25)
+ (add-hook 'xref-backend-functions
+ #'erlang-etags--xref-backend nil t)
+ ;; Test on a function available in the Emacs 19 version
+ ;; of tags but not in the XEmacs version.
+ (when (fboundp 'find-tag-noselect)
+ (erlang-tags-define-keys (current-local-map))
+ (setq erlang-tags-installed t))))))
@@ -4775,8 +4769,6 @@ for a tag on the form `module:tag'."
;;; completion-table' containing all normal tags plus tags on the form
;;; `module:tag' and `module:'.
-;; 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)
@@ -4784,11 +4776,7 @@ for a tag on the form `module:tag'."
(if (fboundp 'advice-add)
;; Emacs 24.4+
(advice-add 'etags-tags-completion-table :around
- (lambda (oldfun)
- (if erlang-replace-etags-tags-completion-table
- (erlang-etags-tags-completion-table)
- (funcall oldfun)))
- (list :name 'erlang-replace-tags-table))
+ #'erlang-etags-tags-completion-table-advice)
;; Emacs 23.1-24.3
(defadvice etags-tags-completion-table (around
erlang-replace-tags-table
@@ -4797,6 +4785,11 @@ for a tag on the form `module:tag'."
(setq ad-return-value (erlang-etags-tags-completion-table))
ad-do-it))))
+(defun erlang-etags-tags-completion-table-advice (oldfun)
+ (if erlang-replace-etags-tags-completion-table
+ (erlang-etags-tags-completion-table)
+ (funcall oldfun)))
+
(defun erlang-complete-tag ()
"Perform tags completion on the text around point.
Completes to the set of names listed in the current tags table.
@@ -4807,8 +4800,7 @@ about Erlang modules."
(condition-case nil
(require 'etags)
(error nil))
- (cond ((and erlang-tags-installed
- (fboundp 'etags-tags-completion-table)
+ (cond ((and (fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
(let ((erlang-replace-etags-tags-completion-table t))
(complete-tag)))
@@ -5213,19 +5205,10 @@ The following special commands are available:
(setq comint-input-ignoredups t)
(setq comint-scroll-show-maximum-output t)
(setq comint-scroll-to-bottom-on-output t)
- ;; In Emacs 19.30, `add-hook' has got a `local' flag, use it. If
- ;; the call fails, just call the normal `add-hook'.
- (condition-case nil
- (progn
- (add-hook 'comint-output-filter-functions
- 'inferior-erlang-strip-delete nil t)
- (add-hook 'comint-output-filter-functions
- 'inferior-erlang-strip-ctrl-m nil t))
- (error
- (funcall (symbol-function 'make-local-hook)
- 'comint-output-filter-functions) ; obsolete as of Emacs 21.1
- (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-delete)
- (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m)))
+ (add-hook 'comint-output-filter-functions
+ 'inferior-erlang-strip-delete nil t)
+ (add-hook 'comint-output-filter-functions
+ 'inferior-erlang-strip-ctrl-m nil t)
;; Some older versions of comint don't have an input ring.
(if (fboundp 'comint-read-input-ring)
(progn
@@ -5251,6 +5234,7 @@ The following special commands are available:
(define-key map [menu-bar compilation]
(cons "Errors" compilation-menu-map)))
map)))))
+ (erlang-tags-init)
(run-hooks 'erlang-shell-mode-hook))
@@ -5730,31 +5714,29 @@ unless the optional NO-DISPLAY is non-nil."
(defun inferior-erlang-format-comma-opts (opts)
(if (null opts)
""
- (concat ", " (inferior-erlang-format-opts opts))))
-
-(defun inferior-erlang-format-opts (opts)
- (concat "[" (inferior-erlang-string-join (mapcar 'inferior-erlang-format-opt
- opts)
- ", ")
- "]"))
+ (concat ", " (inferior-erlang-format-opt opts))))
(defun inferior-erlang-format-opt (opt)
(cond ((stringp opt) (concat "\"" opt "\""))
- ((atom opt) (format "%s" opt))
- ((consp opt) (concat "{" (inferior-erlang-string-join
- (mapcar 'inferior-erlang-format-opt
- (list (car opt) (cdr opt)))
- ", ")
- "}"))
- (t (error (format "Unexpected opt %s" opt)))))
-
-(defun inferior-erlang-string-join (strs sep)
- (let ((result (or (car strs) "")))
- (setq strs (cdr strs))
- (while strs
- (setq result (concat result sep (car strs)))
- (setq strs (cdr strs)))
- result))
+ ((vectorp opt) (inferior-erlang-tuple (append opt nil)))
+ ((atom opt) (format "%s" opt))
+ ((consp opt) (if (listp (cdr opt))
+ (inferior-erlang-list opt)
+ (inferior-erlang-tuple (list (car opt) (cdr opt)))))
+ (t (error "Unexpected erlang compile option %s" opt))))
+
+(defun inferior-erlang-tuple (opts)
+ (concat "{" (mapconcat 'inferior-erlang-format-opt
+ opts
+ ", ")
+ "}"))
+
+(defun inferior-erlang-list (opts)
+ (concat "[" (mapconcat 'inferior-erlang-format-opt
+ opts
+ ", ")
+ "]"))
+
(defun erlang-local-buffer-file-name ()
;; When editing a file remotely via tramp,
diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl
index 26378f28a0..37e67cbe34 100644
--- a/lib/tools/src/make.erl
+++ b/lib/tools/src/make.erl
@@ -317,5 +317,7 @@ check_includes2(Epp, File, ObjMTime) ->
epp:close(Epp),
false;
{error, _Error} ->
+ check_includes2(Epp, File, ObjMTime);
+ {warning, _Warning} ->
check_includes2(Epp, File, ObjMTime)
end.
diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src
index a00969eabe..18166cceb0 100644
--- a/lib/tools/src/tools.app.src
+++ b/lib/tools/src/tools.app.src
@@ -40,7 +40,7 @@
{env, [{file_util_search_methods,[{"", ""}, {"ebin", "esrc"}, {"ebin", "src"}]}
]
},
- {runtime_dependencies, ["stdlib-2.5","runtime_tools-1.8.14",
+ {runtime_dependencies, ["stdlib-3.1","runtime_tools-1.8.14",
"kernel-3.0","inets-5.10","erts-7.0",
"compiler-5.0"]}
]
diff --git a/lib/tools/test/make_SUITE_data/test1.erl b/lib/tools/test/make_SUITE_data/test1.erl
index f4a133008e..9e21bdc767 100644
--- a/lib/tools/test/make_SUITE_data/test1.erl
+++ b/lib/tools/test/make_SUITE_data/test1.erl
@@ -3,6 +3,8 @@
-vsn('$Revision: /main/release/2 $').
-compile(export_all).
+-warning("a warning").
+
f1() ->
true.
diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk
index e6287b0430..e066dbf5e9 100644
--- a/lib/tools/vsn.mk
+++ b/lib/tools/vsn.mk
@@ -1 +1 @@
-TOOLS_VSN = 2.8.5
+TOOLS_VSN = 2.8.6