aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.gitignore1
-rw-r--r--erts/configure.in2
-rw-r--r--erts/doc/src/driver_entry.xml4
-rw-r--r--erts/doc/src/epmd.xml19
-rw-r--r--erts/doc/src/erl.xml9
-rw-r--r--erts/doc/src/erl_nif.xml13
-rw-r--r--erts/doc/src/init.xml13
-rw-r--r--erts/doc/src/notes.xml49
-rw-r--r--erts/emulator/beam/beam_bif_load.c3
-rw-r--r--erts/emulator/beam/beam_debug.c8
-rw-r--r--erts/emulator/beam/beam_emu.c8
-rw-r--r--erts/emulator/beam/beam_load.c2
-rw-r--r--erts/emulator/beam/bif.c2
-rw-r--r--erts/emulator/beam/break.c11
-rw-r--r--erts/emulator/beam/copy.c2
-rw-r--r--erts/emulator/beam/dist.c6
-rw-r--r--erts/emulator/beam/erl_alloc.c6
-rw-r--r--erts/emulator/beam/erl_alloc_util.c36
-rw-r--r--erts/emulator/beam/erl_bif_info.c4
-rw-r--r--erts/emulator/beam/erl_bits.c6
-rw-r--r--erts/emulator/beam/erl_db.c2
-rw-r--r--erts/emulator/beam/erl_db_tree.c2
-rw-r--r--erts/emulator/beam/erl_db_util.c42
-rw-r--r--erts/emulator/beam/erl_driver.h4
-rw-r--r--erts/emulator/beam/erl_gc.c3
-rw-r--r--erts/emulator/beam/erl_nif.c5
-rw-r--r--erts/emulator/beam/erl_nif.h3
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h21
-rw-r--r--erts/emulator/beam/erl_process.c42
-rw-r--r--erts/emulator/beam/erl_process.h1
-rw-r--r--erts/emulator/beam/erl_process_dump.c4
-rw-r--r--erts/emulator/beam/erl_unicode.c2
-rw-r--r--erts/emulator/beam/global.h2
-rw-r--r--erts/emulator/beam/io.c11
-rw-r--r--erts/emulator/beam/utils.c2
-rw-r--r--erts/emulator/drivers/common/efile_drv.c2
-rw-r--r--erts/emulator/drivers/common/gzio.c2
-rw-r--r--erts/emulator/hipe/hipe_debug.c6
-rw-r--r--erts/emulator/sys/common/erl_mseg.c24
-rw-r--r--erts/emulator/test/code_SUITE.erl15
-rw-r--r--erts/emulator/test/nif_SUITE.erl10
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c18
-rw-r--r--erts/emulator/test/process_SUITE.erl50
-rw-r--r--erts/epmd/src/epmd.c43
-rw-r--r--erts/epmd/src/epmd_cli.c2
-rw-r--r--erts/epmd/src/epmd_int.h59
-rw-r--r--erts/epmd/src/epmd_srv.c224
-rw-r--r--erts/etc/common/heart.c6
-rw-r--r--erts/etc/unix/to_erl.c8
-rw-r--r--erts/lib_src/common/erl_printf_format.c27
-rw-r--r--erts/preloaded/ebin/prim_file.beambin31548 -> 31588 bytes
-rw-r--r--erts/preloaded/src/prim_file.erl24
-rw-r--r--lib/common_test/doc/src/common_test_app.xml12
-rw-r--r--lib/common_test/doc/src/write_test_chapter.xml12
-rw-r--r--lib/common_test/src/ct.erl1
-rw-r--r--lib/common_test/src/ct_framework.erl44
-rw-r--r--lib/common_test/src/ct_logs.erl224
-rw-r--r--lib/common_test/src/ct_run.erl14
-rw-r--r--lib/common_test/src/ct_util.erl38
-rw-r--r--lib/common_test/src/vts.erl30
-rw-r--r--lib/common_test/test/ct_config_SUITE.erl3
-rw-r--r--lib/common_test/test/ct_error_SUITE.erl129
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl9
-rw-r--r--lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl26
-rw-r--r--lib/common_test/test/ct_event_handler_SUITE.erl10
-rw-r--r--lib/common_test/test/ct_groups_test_1_SUITE.erl25
-rw-r--r--lib/common_test/test/ct_groups_test_2_SUITE.erl61
-rw-r--r--lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl51
-rw-r--r--lib/common_test/test/ct_hooks_SUITE.erl42
-rw-r--r--lib/common_test/test/ct_master_SUITE.erl7
-rw-r--r--lib/common_test/test/ct_misc_1_SUITE.erl3
-rw-r--r--lib/common_test/test/ct_repeat_1_SUITE.erl4
-rw-r--r--lib/common_test/test/ct_sequence_1_SUITE.erl3
-rw-r--r--lib/common_test/test/ct_skip_SUITE.erl10
-rw-r--r--lib/common_test/test/ct_smoke_test_SUITE.erl39
-rw-r--r--lib/common_test/test/ct_test_server_if_1_SUITE.erl5
-rw-r--r--lib/common_test/test/ct_test_support.erl223
-rw-r--r--lib/common_test/test/ct_testspec_1_SUITE.erl20
-rw-r--r--lib/compiler/src/beam_bsm.erl6
-rw-r--r--lib/compiler/src/beam_dead.erl44
-rw-r--r--lib/compiler/test/andor_SUITE.erl2
-rw-r--r--lib/compiler/test/apply_SUITE.erl2
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl24
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl2
-rw-r--r--lib/compiler/test/compilation_SUITE.erl2
-rw-r--r--lib/compiler/test/compile_SUITE.erl2
-rw-r--r--lib/compiler/test/core_SUITE.erl2
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl2
-rw-r--r--lib/compiler/test/error_SUITE.erl2
-rw-r--r--lib/compiler/test/float_SUITE.erl2
-rw-r--r--lib/compiler/test/fun_SUITE.erl2
-rw-r--r--lib/compiler/test/guard_SUITE.erl2
-rw-r--r--lib/compiler/test/inline_SUITE.erl2
-rw-r--r--lib/compiler/test/lc_SUITE.erl2
-rw-r--r--lib/compiler/test/match_SUITE.erl20
-rw-r--r--lib/compiler/test/misc_SUITE.erl2
-rw-r--r--lib/compiler/test/num_bif_SUITE.erl2
-rw-r--r--lib/compiler/test/pmod_SUITE.erl2
-rw-r--r--lib/compiler/test/receive_SUITE.erl2
-rw-r--r--lib/compiler/test/record_SUITE.erl21
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl2
-rw-r--r--lib/compiler/test/warnings_SUITE.erl2
-rw-r--r--lib/crypto/c_src/crypto.c61
-rw-r--r--lib/crypto/doc/src/crypto.xml42
-rw-r--r--lib/crypto/doc/src/notes.xml17
-rw-r--r--lib/crypto/src/crypto.erl25
-rw-r--r--lib/crypto/test/crypto_SUITE.erl33
-rw-r--r--lib/crypto/vsn.mk2
-rw-r--r--lib/dialyzer/doc/manual.txt33
-rw-r--r--lib/dialyzer/doc/src/dialyzer.xml70
-rw-r--r--lib/dialyzer/src/dialyzer_succ_typings.erl25
-rw-r--r--lib/dialyzer/test/small_tests_SUITE.erl38
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs3
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl28
-rw-r--r--lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl11
-rw-r--r--lib/erl_interface/src/legacy/erl_timeout.c1
-rw-r--r--lib/eunit/src/eunit_lib.erl18
-rw-r--r--lib/eunit/src/eunit_surefire.erl4
-rw-r--r--lib/kernel/src/inet_res.erl203
-rw-r--r--lib/kernel/src/net_kernel.erl2
-rw-r--r--lib/kernel/test/file_SUITE.erl4
-rw-r--r--lib/kernel/test/heart_SUITE.erl13
-rw-r--r--lib/kernel/test/inet_res_SUITE.erl127
-rw-r--r--lib/mnesia/doc/src/notes.xml30
-rw-r--r--lib/mnesia/src/mnesia.appup.src30
-rw-r--r--lib/mnesia/src/mnesia_controller.erl83
-rw-r--r--lib/mnesia/vsn.mk2
-rw-r--r--lib/os_mon/src/disksup.erl4
-rw-r--r--lib/os_mon/src/memsup.erl10
-rw-r--r--lib/public_key/src/public_key.appup.src20
-rw-r--r--lib/public_key/test/pkits_SUITE.erl1472
-rw-r--r--lib/public_key/vsn.mk2
-rw-r--r--lib/sasl/src/rb.erl4
-rw-r--r--lib/ssh/doc/src/notes.xml27
-rw-r--r--lib/ssh/src/ssh.appup.src30
-rwxr-xr-xlib/ssh/src/ssh_bits.erl56
-rw-r--r--lib/ssh/src/ssh_cli.erl2
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl11
-rw-r--r--lib/ssh/src/ssh_userreg.erl28
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/ssl.xml14
-rw-r--r--lib/ssl/src/ssl.appup.src2
-rw-r--r--lib/ssl/src/ssl.erl13
-rw-r--r--lib/ssl/src/ssl_connection.erl4
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/supervisor.xml43
-rw-r--r--lib/stdlib/doc/src/unicode.xml14
-rw-r--r--lib/stdlib/src/gen.erl9
-rw-r--r--lib/stdlib/src/gen_event.erl3
-rw-r--r--lib/stdlib/src/gen_fsm.erl11
-rw-r--r--lib/stdlib/src/gen_server.erl11
-rw-r--r--lib/stdlib/src/pool.erl3
-rw-r--r--lib/stdlib/src/supervisor.erl58
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl21
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl32
-rw-r--r--lib/test_server/src/test_server.erl94
-rw-r--r--lib/test_server/src/test_server_ctrl.erl63
-rw-r--r--lib/test_server/src/test_server_sup.erl2
-rw-r--r--lib/test_server/src/ts_install.erl7
-rw-r--r--lib/test_server/src/ts_run.erl8
-rw-r--r--lib/tools/emacs/erlang.el13
-rw-r--r--lib/tools/src/cover.erl9
-rw-r--r--system/doc/design_principles/sup_princ.xml8
167 files changed, 3591 insertions, 1502 deletions
diff --git a/.gitignore b/.gitignore
index 409be555fb..b35a6c1c31 100644
--- a/.gitignore
+++ b/.gitignore
@@ -179,6 +179,7 @@ make/win32/
# common_test
+/lib/common_test/doc/src/ct_slave.xml
/lib/common_test/priv/install.sh
# compiler
diff --git a/erts/configure.in b/erts/configure.in
index 2590357372..31d1d55b8a 100644
--- a/erts/configure.in
+++ b/erts/configure.in
@@ -1793,7 +1793,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2])
AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \
pread pwrite writev memmove strerror strerror_r strncasecmp \
- gethrtime localtime_r gmtime_r mmap mremap memcpy mallopt \
+ gethrtime localtime_r gmtime_r inet_pton mmap mremap memcpy mallopt \
sbrk _sbrk __sbrk brk _brk __brk \
flockfile fstat strlcpy strlcat setsid posix2time setlocale nl_langinfo poll])
diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml
index 7860d83d83..8bdd154cb9 100644
--- a/erts/doc/src/driver_entry.xml
+++ b/erts/doc/src/driver_entry.xml
@@ -133,7 +133,7 @@ typedef struct erl_drv_entry {
int (*control)(ErlDrvData drv_data, unsigned int command, char *buf,
int len, char **rbuf, int rlen);
/* "ioctl" for drivers - invoked by
- port_control/3) */
+ port_control/3 */
void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */
void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev);
/* called when we have output from erlang
@@ -146,7 +146,7 @@ typedef struct erl_drv_entry {
before 'stop' can be called */
int (*call)(ErlDrvData drv_data, unsigned int command, char *buf,
int len, char **rbuf, int rlen, unsigned int *flags);
- /* Works mostly like 'control', a syncronous
+ /* Works mostly like 'control', a synchronous
call into the driver. */
void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
ErlDrvEventData event_data);
diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml
index 474230cb38..8c3c1e5237 100644
--- a/erts/doc/src/epmd.xml
+++ b/erts/doc/src/epmd.xml
@@ -116,6 +116,16 @@
<p>These options are available when starting the actual name server. The name server is normally started automatically by the <c>erl</c> command (if not already available), but it can also be started at i.e. system start-up.</p>
<taglist>
+ <tag><c><![CDATA[-address List]]></c></tag>
+ <item>
+ <p>Let this instance of <c>epmd</c> listen only on the
+ comma-separated list of IP addresses and on the loopback address
+ (which is implicitely added to the list if it has not been
+ specified). This can also be set using the
+ <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the
+ section <seealso marker="#environment_variables">Environment
+ variables</seealso> below.</p>
+ </item>
<tag><c><![CDATA[-port No]]></c></tag>
<item>
<p>Let this instance of epmd listen to another TCP port than
@@ -228,6 +238,15 @@
<marker id="environment_variables"></marker>
<title>Environment variables</title>
<taglist>
+ <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag>
+ <item>
+ <p>This environment variable may be set to a comma-separated
+ list of IP addresses, in which case the <c>epmd</c> daemon
+ will listen only on the specified address(es) and on the
+ loopback address (which is implicitely added to the list if it
+ has not been specified). The default behaviour is to listen on
+ all available IP addresses.</p>
+ </item>
<tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag>
<item>
<p>This environment variable can contain the port number epmd will use.
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index f4c81d9c47..514ee5ffaf 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1004,6 +1004,15 @@
add to the code path.
See <seealso marker="kernel:code">code(3)</seealso>.</p>
</item>
+ <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag>
+ <item>
+ <p>This environment variable may be set to a comma-separated
+ list of IP addresses, in which case the
+ <seealso marker="epmd">epmd</seealso> daemon
+ will listen only on the specified address(es) and on the
+ loopback address (which is implicitely added to the list if it
+ has not been specified).</p>
+ </item>
<tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag>
<item>
<p>This environment variable can contain the port number to use when
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 4bbd4e2a54..cdce4ec0b8 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -688,6 +688,10 @@ typedef enum {
<fsummary>Determine if a term is an empty list</fsummary>
<desc><p>Return true if <c>term</c> is an empty list.</p></desc>
</func>
+ <marker id="enif_is_exception"/><func><name><ret>int</ret><nametext>enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
+ <fsummary>Determine if a term is an exception</fsummary>
+ <desc><p>Return true if <c>term</c> is an exception.</p></desc>
+ </func>
<func><name><ret>int</ret><nametext>enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name>
<fsummary>Determine if a term is a fun</fsummary>
<desc><p>Return true if <c>term</c> is a fun.</p></desc>
@@ -738,7 +742,14 @@ typedef enum {
</func>
<func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_badarg(ErlNifEnv* env)</nametext></name>
<fsummary>Make a badarg exception.</fsummary>
- <desc><p>Make a badarg exception to be returned from a NIF.</p></desc>
+ <desc><p>Make a badarg exception to be returned from a NIF, and set
+ an associated exception reason in <c>env</c>. If
+ <c>enif_make_badarg</c> is called, the term it returns <em>must</em>
+ be returned from the function that called it. No other return value
+ is allowed. Also, the term returned from <c>enif_make_badarg</c> may
+ be passed only to
+ <seealso marker="#enif_is_exception">enif_is_exception</seealso> and
+ not to any other NIF API function.</p></desc>
</func>
<func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)</nametext></name>
<fsummary>Make a binary term.</fsummary>
diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml
index 33364c709a..0e828389f6 100644
--- a/erts/doc/src/init.xml
+++ b/erts/doc/src/init.xml
@@ -67,19 +67,6 @@
</desc>
</func>
<func>
- <name>get_args() -> [Arg]</name>
- <fsummary>Get all non-flag command line arguments</fsummary>
- <type>
- <v>Arg = atom()</v>
- </type>
- <desc>
- <p>Returns any plain command line arguments as a list of atoms
- (possibly empty). It is recommended that
- <c>get_plain_arguments/1</c> is used instead, because of
- the limited length of atoms.</p>
- </desc>
- </func>
- <func>
<name>get_argument(Flag) -> {ok, Arg} | error</name>
<fsummary>Get the values associated with a command line user flag</fsummary>
<type>
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index 102fa43c1f..f5607945a8 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -30,6 +30,55 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 5.8.3.2</title>
+
+ <section><title>Known Bugs and Problems</title>
+ <list>
+ <item>
+ <p>
+ Fix halfword emulator bug in <c>ets:select_delete</c> for
+ <c>ordered_set</c> that caused emulator to crash.</p>
+ <p>
+ Own Id: OTP-9258 Aux Id: seq11836 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 5.8.3.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Ets table type ordered_set could order large integer keys
+ wrongly on pure 64bit platforms. This is now corrected.</p>
+ <p>
+ Own Id: OTP-9181</p>
+ </item>
+ <item>
+ <p>
+ The status of a process was unnecessarily set to waiting
+ before a process was enqueued in a run queue. This bug
+ was harmless up until OTP-R14B01. In OTP-R14B02
+ <c>erlang:hibernate/3</c> was fixed (OTP-9125). After the
+ introduction of OTP-9125, the previously harmless process
+ status bug sometimes caused erroneous badarg exceptions
+ from <c>process_info()</c>.</p>
+ <p>
+ OTP-9125 also introduced a thread unsafe access to the
+ status field of a process which now also have been fixed.</p>
+ <p>
+ *** INCOMPATIBILITY with noxs ***</p>
+ <p>
+ Own Id: OTP-9197</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 5.8.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 6ae9736141..1ca405961f 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -472,9 +472,6 @@ check_process_code(Process* rp, Module* modp)
for (oh = MSO(rp).first; oh; oh = oh->next) {
if (thing_subtag(oh->thing_word) == FUN_SUBTAG) {
ErlFunThing* funp = (ErlFunThing*) oh;
- BeamInstr* fun_code;
-
- fun_code = funp->fe->address;
if (INSIDE((BeamInstr *) funp->fe->address)) {
if (done_gc) {
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c
index 8a48049921..fffb172c68 100644
--- a/erts/emulator/beam/beam_debug.c
+++ b/erts/emulator/beam/beam_debug.c
@@ -291,7 +291,7 @@ dbg_bt(Process* p, Eterm* sp)
if (addr)
erts_fprintf(stderr,
HEXF ": %T:%T/%bpu\n",
- addr, (Eterm) addr[0], (Eterm) addr[1], (Uint) addr[2]);
+ addr, (Eterm) addr[0], (Eterm) addr[1], addr[2]);
}
sp++;
}
@@ -484,7 +484,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
if (f+3 != (BeamInstr *) *ap) {
erts_print(to, to_arg, "f(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
}
ap++;
}
@@ -495,7 +495,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
if (f+3 != (BeamInstr *) *ap) {
erts_print(to, to_arg, "p(" HEXF ")", *ap);
} else {
- erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]);
+ erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]);
}
ap++;
}
@@ -508,7 +508,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr)
{
Export* ex = (Export *) *ap;
erts_print(to, to_arg,
- "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], (Uint) ex->code[2]);
+ "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], ex->code[2]);
ap++;
}
break;
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 8991f7b198..32ea8588d2 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -3420,7 +3420,8 @@ void process_main(void)
r(0) = c_p->def_arg_reg[0];
x(1) = c_p->def_arg_reg[1];
x(2) = c_p->def_arg_reg[2];
- if (c_p->status == P_WAITING) {
+ if (c_p->flags & F_HIBERNATE_SCHED) {
+ c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
}
Dispatch();
@@ -5225,6 +5226,7 @@ void process_main(void)
OpCase(i_hibernate): {
SWAPOUT;
if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) {
+ c_p->flags &= ~F_HIBERNATE_SCHED;
goto do_schedule;
} else {
I = handle_error(c_p, I, reg, hibernate_3);
@@ -6277,15 +6279,17 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re
PROCESS_MAIN_CHK_LOCKS(c_p);
erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
ASSERT(!ERTS_PROC_IS_EXITING(c_p));
- c_p->status = P_WAITING;
#ifdef ERTS_SMP
ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p);
if (c_p->msg.len > 0)
erts_add_to_runq(c_p);
+ else
#endif
+ c_p->status = P_WAITING;
}
erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS);
c_p->current = bif_export[BIF_hibernate_3]->code;
+ c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */
return 1;
}
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index c697b1ef31..57fe25453d 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -1411,7 +1411,6 @@ static int
load_code(LoaderState* stp)
{
int i;
- int tmp;
int ci;
int last_func_start = 0;
char* sign;
@@ -1931,7 +1930,6 @@ load_code(LoaderState* stp)
case 'P': /* Byte offset into tuple or stack */
case 'Q': /* Like 'P', but packable */
VerifyTag(stp, tag, TAG_u);
- tmp = tmp_op->a[arg].val;
code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm));
break;
case 'l': /* Floating point register. */
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 19ef356041..b3325d635b 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -368,7 +368,6 @@ static int demonitor(Process *c_p, Eterm ref)
ErtsMonitor *mon = NULL; /* The monitor entry to delete */
Process *rp; /* Local target process */
Eterm to = NIL; /* Monitor link traget */
- Eterm ref_p; /* Pid of this end */
DistEntry *dep = NULL; /* Target's distribution entry */
int deref_de = 0;
int res;
@@ -381,7 +380,6 @@ static int demonitor(Process *c_p, Eterm ref)
res = ERTS_DEMONITOR_BADARG;
goto done; /* Cannot be this monitor's ref */
}
- ref_p = c_p->id;
mon = erts_lookup_monitor(c_p->monitors, ref);
if (!mon) {
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index d255cf3558..b8889e6206 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -266,7 +266,7 @@ print_process_info(int to, void *to_arg, Process *p)
}
erts_print(to, to_arg, "Number of heap fragments: %d\n", frags);
}
- erts_print(to, to_arg, "Heap fragment data: %bpu\n", MBUF_SIZE(p));
+ erts_print(to, to_arg, "Heap fragment data: %beu\n", MBUF_SIZE(p));
scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p);
if (scb) {
@@ -313,12 +313,11 @@ print_process_info(int to, void *to_arg, Process *p)
}
/* print the number of reductions etc */
- erts_print(to, to_arg, "Reductions: %bpu\n", p->reds);
+ erts_print(to, to_arg, "Reductions: %beu\n", p->reds);
- erts_print(to, to_arg, "Stack+heap: %bpu\n", p->heap_sz);
+ erts_print(to, to_arg, "Stack+heap: %beu\n", p->heap_sz);
erts_print(to, to_arg, "OldHeap: %bpu\n",
- (OLD_HEAP(p) == NULL) ? 0 :
- (unsigned)(OLD_HEND(p) - OLD_HEAP(p)) );
+ (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HEAP(p)) );
erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop));
erts_print(to, to_arg, "OldHeap unused: %bpu\n",
(OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) );
diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c
index 243e8973cf..90201f3a90 100644
--- a/erts/emulator/beam/copy.c
+++ b/erts/emulator/beam/copy.c
@@ -477,7 +477,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
if (htop != hbot)
erl_exit(ERTS_ABORT_EXIT,
"Internal error in copy_struct() when copying %T:"
- " htop=%p != hbot=%p (sz=%bpu)\n",
+ " htop=%p != hbot=%p (sz=%beu)\n",
org_obj, htop, hbot, org_sz);
#else
if (htop > hbot) {
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 044fd045a6..b1cdd0660a 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -904,7 +904,6 @@ int erts_net_message(Port *prt,
ErtsDistExternal ede;
byte *t;
Sint ctl_len;
- int orig_ctl_len;
Eterm arg;
Eterm from, to;
Eterm watcher, watched;
@@ -985,7 +984,6 @@ int erts_net_message(Port *prt,
PURIFY_MSG("data error");
goto data_error;
}
- orig_ctl_len = ctl_len;
if (ctl_len > DIST_CTL_DEFAULT_SIZE) {
ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm));
@@ -1689,7 +1687,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf)
if (size > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
- "(%bpu bytes) passed.\n",
+ "(%beu bytes) passed.\n",
size);
prt->caller = NIL;
@@ -1716,7 +1714,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf)
if (size > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
"Absurdly large distribution output data buffer "
- "(%bpu bytes) passed.\n",
+ "(%beu bytes) passed.\n",
size);
iov[0].iov_base = NULL;
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 775f4435a9..673eac7fea 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -1913,7 +1913,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg)
/* Print result... */
erts_print(to, arg, "=memory\n");
for (i = 0; i < length; i++)
- erts_print(to, arg, "%T: %bpu\n", atoms[i], *uintps[i]);
+ erts_print(to, arg, "%T: %beu\n", atoms[i], *uintps[i]);
}
if (proc) {
@@ -2107,11 +2107,11 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc)
for (i = 0; i < length; i++) {
switch (values[i].arity) {
case 2:
- erts_print(to, arg, "%s: %bpu\n",
+ erts_print(to, arg, "%s: %beu\n",
values[i].name, values[i].ui[0]);
break;
case 3:
- erts_print(to, arg, "%s: %bpu %bpu\n",
+ erts_print(to, arg, "%s: %beu %beu\n",
values[i].name, values[i].ui[0], values[i].ui[1]);
break;
default:
diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c
index 1394b7e829..84c72439a3 100644
--- a/erts/emulator/beam/erl_alloc_util.c
+++ b/erts/emulator/beam/erl_alloc_util.c
@@ -1877,7 +1877,7 @@ sz_info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers size: %bpu %bpu %bpu\n",
+ "%scarriers size: %beu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
@@ -1933,7 +1933,7 @@ info_carriers(Allctr_t *allctr,
cs->blocks.max_ever.size);
erts_print(to,
arg,
- "%scarriers: %bpu %bpu %bpu\n",
+ "%scarriers: %beu %bpu %bpu\n",
prefix,
curr_no,
cs->max.no,
@@ -1952,7 +1952,7 @@ info_carriers(Allctr_t *allctr,
cs->curr_sys_alloc.no);
erts_print(to,
arg,
- "%scarriers size: %bpu %bpu %bpu\n",
+ "%scarriers size: %beu %bpu %bpu\n",
prefix,
curr_size,
cs->max.size,
@@ -2053,15 +2053,15 @@ info_calls(Allctr_t *allctr,
#define PRINT_CC_4(TO, TOA, NAME, CC) \
if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s calls: %bpu\n", NAME, CC.no); \
+ erts_print(TO, TOA, "%s calls: %b32u\n", NAME, CC.no); \
else \
- erts_print(TO, TOA, "%s calls: %bpu%09lu\n", NAME, CC.giga_no, CC.no)
+ erts_print(TO, TOA, "%s calls: %b32u%09lu\n", NAME, CC.giga_no, CC.no)
#define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \
if ((CC).giga_no == 0) \
- erts_print(TO, TOA, "%s%s calls: %bpu\n",PRFX,NAME,CC.no); \
+ erts_print(TO, TOA, "%s%s calls: %b32u\n",PRFX,NAME,CC.no); \
else \
- erts_print(TO, TOA, "%s%s calls: %bpu%09lu\n",PRFX,NAME,CC.giga_no,CC.no)
+ erts_print(TO, TOA, "%s%s calls: %b32u%09lu\n",PRFX,NAME,CC.giga_no,CC.no)
char *prefix = allctr->name_prefix;
int to = *print_to_p;
@@ -2168,21 +2168,21 @@ info_options(Allctr_t *allctr,
"option e: true\n"
"option t: %s\n"
"option ramv: %s\n"
- "option sbct: %bpu\n"
+ "option sbct: %beu\n"
#if HAVE_ERTS_MSEG
"option asbcst: %bpu\n"
"option rsbcst: %bpu\n"
#endif
- "option rsbcmt: %bpu\n"
- "option rmbcmt: %bpu\n"
- "option mmbcs: %bpu\n"
+ "option rsbcmt: %beu\n"
+ "option rmbcmt: %beu\n"
+ "option mmbcs: %beu\n"
#if HAVE_ERTS_MSEG
- "option mmsbc: %bpu\n"
- "option mmmbc: %bpu\n"
+ "option mmsbc: %beu\n"
+ "option mmmbc: %beu\n"
#endif
- "option lmbcs: %bpu\n"
- "option smbcs: %bpu\n"
- "option mbcgs: %bpu\n",
+ "option lmbcs: %beu\n"
+ "option smbcs: %beu\n"
+ "option mbcgs: %beu\n",
topt,
allctr->ramv ? "true" : "false",
allctr->sbc_threshold,
@@ -2292,9 +2292,9 @@ erts_alcu_au_info_options(int *print_to_p, void *print_to_arg,
erts_print(*print_to_p,
print_to_arg,
#if HAVE_ERTS_MSEG
- "option mmc: %bpu\n"
+ "option mmc: %beu\n"
#endif
- "option ycs: %bpu\n",
+ "option ycs: %beu\n",
#if HAVE_ERTS_MSEG
max_mseg_carriers,
#endif
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 71206c48b2..e50fc18e64 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -71,9 +71,9 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE
#endif
#endif
#ifdef ERTS_SMP
- " [smp:%bpu:%bpu]"
+ " [smp:%beu:%beu]"
#endif
- " [rq:%bpu]"
+ " [rq:%beu]"
#ifdef USE_THREADS
" [async-threads:%d]"
#endif
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 6f8a7436d5..0174e5fc43 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -177,7 +177,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
byte* LSB;
byte* MSB;
Uint* hp;
- Uint* hp_end;
Uint words_needed;
Uint actual;
Uint v32;
@@ -405,7 +404,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff
default:
words_needed = 1+WSIZE(bytes);
hp = HeapOnlyAlloc(p, words_needed);
- hp_end = hp + words_needed;
res = bytes_to_big(LSB, bytes, sgn, hp);
if (is_small(res)) {
p->htop = hp;
@@ -425,7 +423,6 @@ Eterm
erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb)
{
ErlSubBin* sb;
- size_t num_bytes; /* Number of bytes in binary. */
if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */
return THE_NON_VALUE;
@@ -435,7 +432,6 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe
* From now on, we can't fail.
*/
- num_bytes = NBYTES(num_bits);
sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE);
sb->thing_word = HEADER_SUB_BIN;
@@ -1557,7 +1553,6 @@ Uint32
erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
{
Uint bytes;
- Uint bits;
Uint offs;
byte bigbuf[4];
byte* LSB;
@@ -1567,7 +1562,6 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb)
ASSERT(mb->size - mb->offset >= 32);
bytes = 4;
- bits = 8;
offs = 0;
LSB = bigbuf;
diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c
index 61e8a595be..e0a6aa05c6 100644
--- a/erts/emulator/beam/erl_db.c
+++ b/erts/emulator/beam/erl_db.c
@@ -3737,7 +3737,7 @@ static void print_table(int to, void *to_arg, int show, DbTable* tb)
erts_print(to, to_arg, "Objects: %d\n", (int)erts_smp_atomic_read(&tb->common.nitems));
erts_print(to, to_arg, "Words: %bpu\n",
- (Uint) ((erts_smp_atomic_read(&tb->common.memory_size)
+ (UWord) ((erts_smp_atomic_read(&tb->common.memory_size)
+ sizeof(Uint)
- 1)
/ sizeof(Uint)));
diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c
index 6cdbec3213..a59c0c258d 100644
--- a/erts/emulator/beam/erl_db_tree.c
+++ b/erts/emulator/beam/erl_db_tree.c
@@ -575,7 +575,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret)
return DB_ERROR_NONE;
}
-static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
+static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base,
TreeDbTerm* obj)
{
return cmp_rel(key, key_base,
diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c
index 0b63ab9ba0..c3b074f782 100644
--- a/erts/emulator/beam/erl_db_util.c
+++ b/erts/emulator/beam/erl_db_util.c
@@ -5046,31 +5046,31 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("TryMeElse\t%bpu\n", n);
+ erts_printf("TryMeElse\t%beu\n", n);
break;
case matchArray:
++t;
n = *t;
++t;
- erts_printf("Array\t%bpu\n", n);
+ erts_printf("Array\t%beu\n", n);
break;
case matchArrayBind:
++t;
n = *t;
++t;
- erts_printf("ArrayBind\t%bpu\n", n);
+ erts_printf("ArrayBind\t%beu\n", n);
break;
case matchTuple:
++t;
n = *t;
++t;
- erts_printf("Tuple\t%bpu\n", n);
+ erts_printf("Tuple\t%beu\n", n);
break;
case matchPushT:
++t;
n = *t;
++t;
- erts_printf("PushT\t%bpu\n", n);
+ erts_printf("PushT\t%beu\n", n);
break;
case matchPushL:
++t;
@@ -5084,13 +5084,13 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("Bind\t%bpu\n", n);
+ erts_printf("Bind\t%beu\n", n);
break;
case matchCmp:
++t;
n = *t;
++t;
- erts_printf("Cmp\t%bpu\n", n);
+ erts_printf("Cmp\t%beu\n", n);
break;
case matchEqBin:
++t;
@@ -5112,9 +5112,9 @@ void db_match_dis(Binary *bp)
else
erts_printf(", ");
#if defined(ARCH_64) && !HALFWORD_HEAP
- erts_printf("0x%016bpx", rt->data.ui[ri]);
+ erts_printf("0x%016bex", rt->data.ui[ri]);
#else
- erts_printf("0x%08bpx", rt->data.ui[ri]);
+ erts_printf("0x%08bex", rt->data.ui[ri]);
#endif
}
}
@@ -5136,9 +5136,9 @@ void db_match_dis(Binary *bp)
else
erts_printf(", ");
#if defined(ARCH_64) && !HALFWORD_HEAP
- erts_printf("0x%016bpx", *et);
+ erts_printf("0x%016bex", *et);
#else
- erts_printf("0x%08bpx", *et);
+ erts_printf("0x%08bex", *et);
#endif
++et;
}
@@ -5190,31 +5190,31 @@ void db_match_dis(Binary *bp)
++t;
n = *t;
++t;
- erts_printf("MkTuple\t%bpu\n", n);
+ erts_printf("MkTuple\t%beu\n", n);
break;
case matchOr:
++t;
n = *t;
++t;
- erts_printf("Or\t%bpu\n", n);
+ erts_printf("Or\t%beu\n", n);
break;
case matchAnd:
++t;
n = *t;
++t;
- erts_printf("And\t%bpu\n", n);
+ erts_printf("And\t%beu\n", n);
break;
case matchOrElse:
++t;
n = *t;
++t;
- erts_printf("OrElse\t%bpu\n", n);
+ erts_printf("OrElse\t%beu\n", n);
break;
case matchAndAlso:
++t;
n = *t;
++t;
- erts_printf("AndAlso\t%bpu\n", n);
+ erts_printf("AndAlso\t%beu\n", n);
break;
case matchCall0:
++t;
@@ -5244,19 +5244,19 @@ void db_match_dis(Binary *bp)
++t;
n = (Uint) *t;
++t;
- erts_printf("PushV\t%bpu\n", n);
+ erts_printf("PushV\t%beu\n", n);
break;
#if HALFWORD_HEAP
case matchPushVGuard:
n = (Uint) *++t;
++t;
- erts_printf("PushVGuard\t%bpu\n", n);
+ erts_printf("PushVGuard\t%beu\n", n);
break;
#endif
case matchPushVResult:
n = (Uint) *++t;
++t;
- erts_printf("PushVResult\t%bpu\n", n);
+ erts_printf("PushVResult\t%beu\n", n);
break;
case matchTrue:
++t;
@@ -5367,8 +5367,8 @@ void db_match_dis(Binary *bp)
}
erts_printf("}\n");
erts_printf("num_bindings: %d\n", prog->num_bindings);
- erts_printf("heap_size: %bpu\n", prog->heap_size);
- erts_printf("stack_offset: %bpu\n", prog->stack_offset);
+ erts_printf("heap_size: %beu\n", prog->heap_size);
+ erts_printf("stack_offset: %beu\n", prog->stack_offset);
erts_printf("text: 0x%08x\n", (unsigned long) prog->text);
erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset);
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 3c0eade0d8..069b71ab0d 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -294,7 +294,7 @@ typedef struct erl_drv_entry {
int (*control)(ErlDrvData drv_data, unsigned int command, char *buf,
int len, char **rbuf, int rlen);
/* "ioctl" for drivers - invoked by
- port_control/3) */
+ port_control/3 */
void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */
void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev);
/* called when we have output from erlang
@@ -307,7 +307,7 @@ typedef struct erl_drv_entry {
before 'stop' can be called */
int (*call)(ErlDrvData drv_data, unsigned int command, char *buf,
int len, char **rbuf, int rlen, unsigned int *flags);
- /* Works mostly like 'control', a syncronous
+ /* Works mostly like 'control', a synchronous
call into the driver. */
void (*event)(ErlDrvData drv_data, ErlDrvEvent event,
ErlDrvEventData event_data);
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 735986ba54..5edcd667e7 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -455,7 +455,6 @@ erts_garbage_collect_hibernate(Process* p)
Eterm* heap;
Eterm* htop;
Rootset rootset;
- int n;
char* src;
Uint src_size;
Uint actual_size;
@@ -486,7 +485,7 @@ erts_garbage_collect_hibernate(Process* p)
sizeof(Eterm)*heap_size);
htop = heap;
- n = setup_rootset(p, p->arg_reg, p->arity, &rootset);
+ (void) setup_rootset(p, p->arg_reg, p->arity, &rootset);
#if HIPE
hipe_empty_nstack(p);
#endif
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 135c6b0ccc..8b48444904 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -430,6 +430,11 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term)
return is_list(term) || is_nil(term);
}
+int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)
+{
+ return term == THE_NON_VALUE;
+}
+
static void aligned_binary_dtor(struct enif_tmp_obj_t* obj)
{
erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP);
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 8050b3640a..d028567faf 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -31,9 +31,10 @@
** 1.0: R13B04
** 2.0: R14A
** 2.1: R14B02 "vm_variant"
+** 2.2: R14B03 enif_is_exception
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 1
+#define ERL_NIF_MINOR_VERSION 2
#include <stdlib.h>
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index eca506593d..c991b61abe 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2009-2010. All Rights Reserved.
+ * Copyright Ericsson AB 2009-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -21,6 +21,13 @@
# error This file should not be included directly
#endif
+/*
+** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list
+** to keep compatibility on Windows!!!
+**
+** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h
+** when adding functions to the API.
+*/
#ifdef ERL_NIF_API_FUNC_DECL
ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*));
ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size));
@@ -128,12 +135,17 @@ ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNif
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64));
ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
#endif
+ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term));
/*
-** Add last to keep compatibility on Windows!!!
+** Add new entries here to keep compatibility on Windows!!!
*/
#endif
+/*
+** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order
+** as the ERL_NIF_API_FUNC_DECL list above
+*/
#ifdef ERL_NIF_API_FUNC_MACRO
# define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data)
# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc)
@@ -243,6 +255,11 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64));
# define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64)
#endif
+# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception)
+
+/*
+** Add new entries here
+*/
#endif
#ifndef enif_make_list1
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index f8997f3c07..31f23d3978 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -1267,7 +1267,6 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi)
static void
wake_scheduler(ErtsRunQueue *rq, int incq, int one)
{
- int res;
ErtsSchedulerSleepInfo *ssi;
ErtsSchedulerSleepList *sl;
@@ -1298,7 +1297,6 @@ wake_scheduler(ErtsRunQueue *rq, int incq, int one)
if (ssi->next)
ssi->next->prev = ssi->prev;
- res = sl->list != NULL;
erts_smp_spin_unlock(&sl->lock);
ERTS_THR_MEMORY_BARRIER;
@@ -2857,7 +2855,6 @@ resume_process(Process *p)
return;
switch(p->rstatus) {
case P_RUNABLE:
- *statusp = P_WAITING; /* make erts_add_to_runq work */
erts_add_to_runq(p);
break;
case P_WAITING:
@@ -3668,7 +3665,7 @@ sched_thread_func(void *vesdp)
#ifdef ERTS_ENABLE_LOCK_CHECK
{
char buf[31];
- erts_snprintf(&buf[0], 31, "scheduler %bpu", no);
+ erts_snprintf(&buf[0], 31, "scheduler %beu", no);
erts_lc_set_thread_name(&buf[0]);
}
#endif
@@ -3726,7 +3723,7 @@ sched_thread_func(void *vesdp)
process_main();
/* No schedulers should *ever* terminate */
- erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n",
+ erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n",
((ErtsSchedulerData *) vesdp)->no);
return NULL;
}
@@ -3775,8 +3772,8 @@ erts_start_schedulers(void)
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
ASSERT(actual != wanted_no_schedulers);
erts_dsprintf(dsbufp,
- "Failed to create %bpu scheduler-threads (%s:%d); "
- "only %bpu scheduler-thread%s created.\n",
+ "Failed to create %beu scheduler-threads (%s:%d); "
+ "only %beu scheduler-thread%s created.\n",
wanted_no_schedulers, erl_errno_id(res), res,
actual, actual == 1 ? " was" : "s were");
erts_send_error_to_logger_nogl(dsbufp);
@@ -4653,7 +4650,7 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p)
if (p->status_flags & ERTS_PROC_SFLG_INRUNQ)
return NULL;
else if (p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) {
- ASSERT(p->status != P_SUSPENDED);
+ ASSERT(p->rcount == 0);
ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p);
p->status_flags |= ERTS_PROC_SFLG_PENDADD2SCHEDQ;
return NULL;
@@ -4664,9 +4661,8 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p)
ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p);
#ifndef ERTS_SMP
/* Never schedule a suspended process (ok in smp case) */
- ASSERT(p->status != P_SUSPENDED);
+ ASSERT(p->rcount == 0);
add_runq = runq;
-
#else
ASSERT(!p->bound_runq || p->bound_runq == p->run_queue);
if (p->bound_runq) {
@@ -5166,7 +5162,7 @@ Process *schedule(Process *p, int calls)
handle_pending_suspend(p,
ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS);
ASSERT(!(p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ)
- || p->status != P_SUSPENDED);
+ || p->rcount == 0);
}
#endif
erts_smp_runq_lock(rq);
@@ -7611,10 +7607,28 @@ timeout_proc(Process* p)
p->flags |= F_TIMO;
p->flags &= ~F_INSLPQUEUE;
- if (p->status == P_WAITING)
- erts_add_to_runq(p);
- if (p->status == P_SUSPENDED)
+ switch (p->status) {
+ case P_GARBING:
+ switch (p->gcstatus) {
+ case P_SUSPENDED:
+ goto suspended;
+ case P_WAITING:
+ goto waiting;
+ default:
+ break;
+ }
+ break;
+ case P_WAITING:
+ waiting:
+ erts_add_to_runq(p);
+ break;
+ case P_SUSPENDED:
+ suspended:
p->rstatus = P_RUNABLE; /* MUST set resume status to runnable */
+ break;
+ default:
+ break;
+ }
}
diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h
index 8f78a7d76e..334ae5573f 100644
--- a/erts/emulator/beam/erl_process.h
+++ b/erts/emulator/beam/erl_process.h
@@ -895,6 +895,7 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags;
#define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */
#define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */
#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */
+#define F_HIBERNATE_SCHED (1 << 11) /* Schedule out after hibernate op */
/* process trace_flags */
#define F_SENSITIVE (1 << 0)
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 68fda01597..5410bcd495 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -194,7 +194,7 @@ dump_element(int to, void *to_arg, Eterm x)
} else if (is_pid(x)) {
erts_print(to, to_arg, "P%T", x);
} else if (is_port(x)) {
- erts_print(to, to_arg, "p<%bpu.%bpu>",
+ erts_print(to, to_arg, "p<%beu.%beu>",
port_channel_no(x), port_number(x));
} else if (is_nil(x)) {
erts_putc(to, to_arg, 'N');
@@ -376,7 +376,7 @@ heap_dump(int to, void *to_arg, Eterm x)
erts_print(to, to_arg, "P%T\n", x);
*ptr = OUR_NIL;
} else if (is_external_port_header(hdr)) {
- erts_print(to, to_arg, "p<%bpu.%bpu>\n",
+ erts_print(to, to_arg, "p<%beu.%beu>\n",
port_channel_no(x), port_number(x));
*ptr = OUR_NIL;
} else {
diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c
index 545b345a71..dacf228e92 100644
--- a/erts/emulator/beam/erl_unicode.c
+++ b/erts/emulator/beam/erl_unicode.c
@@ -902,7 +902,6 @@ static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos,
static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
{
Eterm *real_bin;
- Sint need;
byte* bytes;
Eterm rest_term;
int left, sleft;
@@ -918,7 +917,6 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3)
ASSERT(is_binary(BIF_ARG_1));
real_bin = binary_val(BIF_ARG_1);
ASSERT(*real_bin == HEADER_PROC_BIN);
- need = ((ProcBin *) real_bin)->val->orig_size;
pos = (int) binary_size(BIF_ARG_1);
bytes = binary_bytes(BIF_ARG_1);
sleft = left = allowed_iterations(BIF_P);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 432bdd705b..96da894d90 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -1828,7 +1828,7 @@ erts_alloc_message_heap(Uint size,
#endif
if (size > (Uint) INT_MAX)
- erl_exit(ERTS_ABORT_EXIT, "HUGE size (%bpu)\n", size);
+ erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size);
if (
#if defined(ERTS_SMP)
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index f21a96c754..f619c6f88b 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 1996-2010. All Rights Reserved.
+ * Copyright Ericsson AB 1996-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -1226,7 +1226,6 @@ void init_io(void)
{
int i;
ErlDrvEntry** dp;
- ErlDrvEntry* drv;
char maxports[21]; /* enough for any 64-bit integer */
size_t maxportssize = sizeof(maxports);
Uint ports_bits = ERTS_PORTS_BITS;
@@ -1309,10 +1308,8 @@ void init_io(void)
init_driver(&fd_driver, &fd_driver_entry, NULL);
init_driver(&vanilla_driver, &vanilla_driver_entry, NULL);
init_driver(&spawn_driver, &spawn_driver_entry, NULL);
- for (dp = driver_tab; *dp != NULL; dp++) {
- drv = *dp;
+ for (dp = driver_tab; *dp != NULL; dp++)
erts_add_driver_entry(*dp, NULL, 1);
- }
erts_smp_tsd_set(driver_list_lock_status_key, NULL);
erts_smp_mtx_unlock(&erts_driver_list_lock);
@@ -2420,7 +2417,7 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len)
if (len > (Uint) INT_MAX)
erl_exit(ERTS_ABORT_EXIT,
- "Absurdly large data buffer (%bpu bytes) passed to"
+ "Absurdly large data buffer (%beu bytes) passed to"
"output callback of %s driver.\n",
len,
p->drv_ptr->name ? p->drv_ptr->name : "unknown");
@@ -3670,7 +3667,7 @@ driver_pdl_inc_refc(ErlDrvPDL pdl)
{
ErlDrvSInt refc = pdl_inctest_refc(pdl);
#ifdef HARDDEBUG
- erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bpd\r\n",
+ erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bed\r\n",
pdl, refc);
#endif
return refc;
diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c
index f531d1430b..6b4f3b3b36 100644
--- a/erts/emulator/beam/utils.c
+++ b/erts/emulator/beam/utils.c
@@ -2705,7 +2705,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */
while (--i) {
a = *aa++;
b = *bb++;
- if (a != b) {
+ if (!is_same(a,a_base, b,b_base)) {
if (is_atom(a) && is_atom(b)) {
if ((j = cmp_atoms(a, b)) != 0) {
goto not_equal;
diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c
index 4e9b5005c1..f0ff3f54c5 100644
--- a/erts/emulator/drivers/common/efile_drv.c
+++ b/erts/emulator/drivers/common/efile_drv.c
@@ -410,7 +410,7 @@ struct t_data
static void *ef_safe_alloc(Uint s)
{
void *p = EF_ALLOC(s);
- if (!p) erl_exit(1, "efile drv: Can't allocate %d bytes of memory\n", s);
+ if (!p) erl_exit(1, "efile drv: Can't allocate %lu bytes of memory\n", (unsigned long)s);
return p;
}
diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c
index 5531a275ea..741cb6ae20 100644
--- a/erts/emulator/drivers/common/gzio.c
+++ b/erts/emulator/drivers/common/gzio.c
@@ -632,6 +632,7 @@ erts_gzseek(gzFile file, int offset, int whence)
while (s->position < pos) {
char buf[512];
int n;
+ int save_pos = s->position;
n = pos - s->position;
if (n > sizeof(buf))
@@ -643,6 +644,7 @@ erts_gzseek(gzFile file, int offset, int whence)
memset(buf, '\0', n);
erts_gzwrite(file, buf, n);
}
+ if (save_pos == s->position) break;
}
return s->position;
diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c
index c7b608aafe..7ca11f8c6c 100644
--- a/erts/emulator/hipe/hipe_debug.c
+++ b/erts/emulator/hipe/hipe_debug.c
@@ -51,7 +51,7 @@ static const char stars[2*sizeof(long)+5] = {
extern Uint beam_apply[];
-static void print_beam_pc(Uint *pc)
+static void print_beam_pc(BeamInstr *pc)
{
if (pc == hipe_beam_pc_return) {
printf("return-to-native");
@@ -60,7 +60,7 @@ static void print_beam_pc(Uint *pc)
} else if (pc == &beam_apply[1]) {
printf("normal-process-exit");
} else {
- Eterm *mfa = find_function_from_pc(pc);
+ BeamInstr *mfa = find_function_from_pc(pc);
if (mfa)
erts_printf("%T:%T/%bpu + 0x%bpx",
mfa[0], mfa[1], mfa[2], pc - &mfa[3]);
@@ -71,7 +71,7 @@ static void print_beam_pc(Uint *pc)
static void catch_slot(Eterm *pos, Eterm val)
{
- Uint *pc = catch_pc(val);
+ BeamInstr *pc = catch_pc(val);
printf(" | 0x%0*lx | 0x%0*lx | CATCH 0x%0*lx (BEAM ",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)val,
diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c
index ceb290b644..ffa3a6328c 100644
--- a/erts/emulator/sys/common/erl_mseg.c
+++ b/erts/emulator/sys/common/erl_mseg.c
@@ -1092,10 +1092,10 @@ info_options(char *prefix,
if (print_to_p) {
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "%samcbf: %bpu\n", prefix, abs_max_cache_bad_fit);
- erts_print(to, arg, "%srmcbf: %bpu\n", prefix, rel_max_cache_bad_fit);
- erts_print(to, arg, "%smcs: %bpu\n", prefix, max_cache_size);
- erts_print(to, arg, "%scci: %bpu\n", prefix, cache_check_interval);
+ erts_print(to, arg, "%samcbf: %beu\n", prefix, abs_max_cache_bad_fit);
+ erts_print(to, arg, "%srmcbf: %beu\n", prefix, rel_max_cache_bad_fit);
+ erts_print(to, arg, "%smcs: %beu\n", prefix, max_cache_size);
+ erts_print(to, arg, "%scci: %beu\n", prefix, cache_check_interval);
}
if (hpp || szp) {
@@ -1131,9 +1131,9 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp)
#define PRINT_CC(TO, TOA, CC) \
if (calls.CC.giga_no == 0) \
- erts_print(TO, TOA, "mseg_%s calls: %bpu\n", #CC, calls.CC.no); \
+ erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, calls.CC.no); \
else \
- erts_print(TO, TOA, "mseg_%s calls: %bpu%09bpu\n", #CC, \
+ erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \
calls.CC.giga_no, calls.CC.no)
int to = *print_to_p;
@@ -1215,13 +1215,13 @@ info_status(MemKind* mk, int *print_to_p, void *print_to_arg,
int to = *print_to_p;
void *arg = print_to_arg;
- erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size);
- erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits);
- erts_print(to, arg, "segments: %bpu %bpu %bpu\n",
+ erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size);
+ erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits);
+ erts_print(to, arg, "segments: %beu %beu %beu\n",
mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no);
- erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n",
+ erts_print(to, arg, "segments_size: %beu %beu %beu\n",
mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz);
- erts_print(to, arg, "segments_watermark: %bpu\n",
+ erts_print(to, arg, "segments_watermark: %beu\n",
mk->segments.current.watermark);
}
@@ -1507,7 +1507,7 @@ erts_mseg_init(ErtsMsegInit_t *init)
while ((page_size >> page_shift) != 1) {
if ((page_size & (1 << (page_shift - 1))) != 0)
erl_exit(ERTS_ABORT_EXIT,
- "erts_mseg: Unexpected page_size %bpu\n", page_size);
+ "erts_mseg: Unexpected page_size %beu\n", page_size);
page_shift++;
}
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 703a00a598..c1a048be75 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -483,7 +483,7 @@ do_false_dependency(Init, Code) ->
%% Spawn process. Make sure it has the appropriate init function
%% and returned. CP should not contain garbage after the return.
Parent = self(),
- ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init) end),
+ ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end),
?line receive initialized -> ok end,
%% Reload the module. Make sure the process is still alive.
@@ -501,11 +501,18 @@ do_false_dependency(Init, Code) ->
?line true = erlang:purge_module(cpbugx),
ok.
-false_dependency_loop(Parent, Init) ->
+false_dependency_loop(Parent, Init, SendInitAck) ->
Init(),
- Parent ! initialized,
+ case SendInitAck of
+ true -> Parent ! initialized;
+ false -> void
+ %% Just send one init-ack. I guess the point of this test
+ %% wasn't to fill parents msg-queue (?). Seen to cause
+ %% out-of-mem (on halfword-vm for some reason) by
+ %% 91 million msg in queue. /sverker
+ end,
receive
- _ -> false_dependency_loop(Parent, Init)
+ _ -> false_dependency_loop(Parent, Init, false)
end.
coverage(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index b79c30d8d9..91d695d979 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -1121,7 +1121,14 @@ is_checks(Config) when is_list(Config) ->
?line ensure_lib_loaded(Config, 1),
?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end,
self(), hd(erlang:ports()), [], [1,9,9,8],
- {hejsan, "hejsan", [$h,"ejs",<<"an">>]}).
+ {hejsan, "hejsan", [$h,"ejs",<<"an">>]}),
+ try
+ ?line error = check_is_exception(),
+ ?line throw(expected_badarg)
+ catch
+ error:badarg ->
+ ?line ok
+ end.
get_length(doc) -> ["Test all enif_get_length functions"];
get_length(Config) when is_list(Config) ->
@@ -1245,6 +1252,7 @@ release_resource(_) -> ?nif_stub.
last_resource_dtor_call() -> ?nif_stub.
make_new_resource(_,_) -> ?nif_stub.
check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub.
+check_is_exception() -> ?nif_stub.
length_test(_,_,_,_,_) -> ?nif_stub.
make_atoms() -> ?nif_stub.
make_strings() -> ?nif_stub.
diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
index 8489124966..dc047394b5 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -802,6 +802,23 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
}
/*
+ * no arguments
+ *
+ * This function is separate from check_is because it calls enif_make_badarg
+ * and so it must return the badarg exception as its return value. Thus, the
+ * badarg exception indicates success. Failure is indicated by returning an
+ * error atom.
+ */
+static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM error_atom = enif_make_atom(env, "error");
+ ERL_NIF_TERM badarg = enif_make_badarg(env);
+ if (enif_is_exception(env, error_atom)) return error_atom;
+ if (!enif_is_exception(env, badarg)) return error_atom;
+ return badarg;
+}
+
+/*
* argv[0] atom with length of 6
* argv[1] list with length of 6
* argv[2] empty list
@@ -1383,6 +1400,7 @@ static ErlNifFunc nif_funcs[] =
{"last_resource_dtor_call", 0, last_resource_dtor_call},
{"make_new_resource", 2, make_new_resource},
{"check_is", 10, check_is},
+ {"check_is_exception", 0, check_is_exception},
{"length_test", 5, length_test},
{"make_atoms", 0, make_atoms},
{"make_strings", 0, make_strings},
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index a731f09e4c..36bae908aa 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -39,6 +39,7 @@
process_info_other_dist_msg/1,
process_info_2_list/1, process_info_lock_reschedule/1,
process_info_lock_reschedule2/1,
+ process_info_lock_reschedule3/1,
bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1,
process_status_exiting/1,
otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1,
@@ -65,7 +66,8 @@ all() ->
t_process_info, process_info_other_msg,
process_info_other_dist_msg, process_info_2_list,
process_info_lock_reschedule,
- process_info_lock_reschedule2, process_status_exiting,
+ process_info_lock_reschedule2,
+ process_info_lock_reschedule3, process_status_exiting,
bump_reductions, low_prio, yield, yield2, otp_4725,
bad_register, garbage_collect, process_info_messages,
process_flag_badarg, process_flag_heap_size,
@@ -702,6 +704,52 @@ process_info_lock_reschedule2(Config) when is_list(Config) ->
?line unlink(P6), exit(P6, bang),
?line ok.
+many_args(0,_B,_C,_D,_E,_F,_G,_H,_I,_J) ->
+ ok;
+many_args(A,B,C,D,E,F,G,H,I,J) ->
+ many_args(A-1,B,C,D,E,F,G,H,I,J).
+
+do_pi_msg_len(PT, AT) ->
+ lists:map(fun (_) -> ok end, [a,b,c,d]),
+ {message_queue_len, _} = process_info(element(2,PT), element(2,AT)).
+
+process_info_lock_reschedule3(doc) ->
+ [];
+process_info_lock_reschedule3(suite) ->
+ [];
+process_info_lock_reschedule3(Config) when is_list(Config) ->
+ %% We need a process that is running and an item that requires
+ %% process_info to take the main process lock.
+ ?line Target1 = spawn_link(fun tok_loop/0),
+ ?line Name1 = process_info_lock_reschedule_running,
+ ?line register(Name1, Target1),
+ ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end),
+ ?line Name2 = process_info_lock_reschedule_waiting,
+ ?line register(Name2, Target2),
+ ?line PI = fun(N) ->
+ case N rem 10 of
+ 0 -> erlang:yield();
+ _ -> ok
+ end,
+ ?line do_pi_msg_len({proc, Target1},
+ {arg, message_queue_len})
+ end,
+ ?line many_args(100000,1,2,3,4,5,6,7,8,9),
+ ?line lists:foreach(PI, lists:seq(1,1000000)),
+ %% Make sure Target1 still is willing to "tok loop"
+ ?line case process_info(Target1, status) of
+ {status, OkStatus} when OkStatus == runnable;
+ OkStatus == running;
+ OkStatus == garbage_collecting ->
+ ?line unlink(Target1),
+ ?line unlink(Target2),
+ ?line exit(Target1, bang),
+ ?line exit(Target2, bang),
+ ?line OkStatus;
+ {status, BadStatus} ->
+ ?line ?t:fail(BadStatus)
+ end.
+
process_status_exiting(Config) when is_list(Config) ->
%% Make sure that erts_debug:get_internal_state({process_status,P})
%% returns exiting if it is in status P_EXITING.
diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c
index e94533f0ba..a1f202251c 100644
--- a/erts/epmd/src/epmd.c
+++ b/erts/epmd/src/epmd.c
@@ -33,6 +33,7 @@
static void usage(EpmdVars *);
static void run_daemon(EpmdVars*);
+static char* get_addresses(void);
static int get_port_no(void);
static int check_relaxed(void);
#ifdef __WIN32__
@@ -133,6 +134,7 @@ int main(int argc, char** argv)
{
EpmdVars g_empd_vars;
EpmdVars *g = &g_empd_vars;
+ int i;
#ifdef __WIN32__
WORD wVersionRequested;
WSADATA wsaData;
@@ -158,8 +160,9 @@ int main(int argc, char** argv)
g->argv = NULL;
#endif
- g->port = get_port_no();
- g->debug = 0;
+ g->addresses = get_addresses();
+ g->port = get_port_no();
+ g->debug = 0;
g->silent = 0;
g->is_daemon = 0;
@@ -168,12 +171,14 @@ int main(int argc, char** argv)
g->delay_accept = 0;
g->delay_write = 0;
g->progname = argv[0];
- g->listenfd = -1;
g->conn = NULL;
g->nodes.reg = g->nodes.unreg = g->nodes.unreg_tail = NULL;
g->nodes.unreg_count = 0;
g->active_conn = 0;
+ for (i = 0; i < MAX_LISTEN_SOCKETS; i++)
+ g->listenfd[i] = -1;
+
argc--;
argv++;
while (argc > 0) {
@@ -208,6 +213,11 @@ int main(int argc, char** argv)
else
usage(g);
epmd_cleanup_exit(g,0);
+ } else if (strcmp(argv[0], "-address") == 0) {
+ if (argc == 1)
+ usage(g);
+ g->addresses = argv[1];
+ argv += 2; argc -= 2;
} else if (strcmp(argv[0], "-port") == 0) {
if ((argc == 1) ||
((g->port = atoi(argv[1])) == 0))
@@ -252,13 +262,10 @@ int main(int argc, char** argv)
/*
* max_conn must not be greater than FD_SETSIZE.
* (at least QNX crashes)
- *
- * More correctly, it must be FD_SETSIZE - 1, beacuse the
- * listen FD is stored outside the connection array.
*/
if (g->max_conn > FD_SETSIZE) {
- g->max_conn = FD_SETSIZE - 1;
+ g->max_conn = FD_SETSIZE;
}
if (g->is_daemon) {
@@ -393,11 +400,14 @@ static void run_daemon(EpmdVars *g)
static void usage(EpmdVars *g)
{
- fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-port No] [-daemon]\n");
- fprintf(stderr, " [-relaxed_command_check]\n");
+ fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-address List]\n");
+ fprintf(stderr, " [-port No] [-daemon] [-relaxed_command_check]\n");
fprintf(stderr, " epmd [-d|-debug] [-port No] [-names|-kill|-stop name]\n\n");
fprintf(stderr, "See the Erlang epmd manual page for info about the usage.\n\n");
fprintf(stderr, "Regular options\n");
+ fprintf(stderr, " -address List\n");
+ fprintf(stderr, " Let epmd listen only on the comma-separated list of IP\n");
+ fprintf(stderr, " addresses (and on the loopback interface).\n");
fprintf(stderr, " -port No\n");
fprintf(stderr, " Let epmd listen to another port than default %d\n",
EPMD_PORT_NO);
@@ -487,8 +497,8 @@ static void dbg_gen_printf(int onsyslog,int perr,int from_level,
(int) strlen(timestr)-1, timestr);
len = strlen(buf);
erts_vsnprintf(buf + len, DEBUG_BUFFER_SIZE - len, format, args);
- if (perr == 1)
- perror(buf);
+ if (perr != 0)
+ fprintf(stderr,"%s: %s\r\n",buf,strerror(perr));
else
fprintf(stderr,"%s\r\n",buf);
}
@@ -499,7 +509,7 @@ void dbg_perror(EpmdVars *g,const char *format,...)
{
va_list args;
va_start(args, format);
- dbg_gen_printf(1,1,0,g,format,args);
+ dbg_gen_printf(1,errno,0,g,format,args);
va_end(args);
}
@@ -555,8 +565,9 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval)
epmd_conn_close(g,&g->conn[i]);
free(g->conn);
}
- if(g->listenfd >= 0)
- close(g->listenfd);
+ for(i=0; i < MAX_LISTEN_SOCKETS; i++)
+ if(g->listenfd[i] >= 0)
+ close(g->listenfd[i]);
free_all_nodes(g);
if(g->argv){
for(i=0; g->argv[i] != NULL; ++i)
@@ -568,6 +579,10 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval)
exit(exitval);
}
+static char* get_addresses(void)
+{
+ return getenv("ERL_EPMD_ADDRESS");
+}
static int get_port_no(void)
{
char* port_str = getenv("ERL_EPMD_PORT");
diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c
index 7c60ba0420..ac55ba6bb6 100644
--- a/erts/epmd/src/epmd_cli.c
+++ b/erts/epmd/src/epmd_cli.c
@@ -137,7 +137,7 @@ static int conn_to_epmd(EpmdVars *g)
{ /* store port number in unsigned short */
unsigned short sport = g->port;
- SET_ADDR_LOOPBACK(address, FAMILY, sport);
+ SET_ADDR(address, EPMD_ADDR_LOOPBACK, sport);
}
if (connect(connect_sock, (struct sockaddr*)&address, sizeof address) < 0)
diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h
index c2558d52a1..2a0de4df9c 100644
--- a/erts/epmd/src/epmd_int.h
+++ b/erts/epmd/src/epmd_int.h
@@ -168,42 +168,40 @@
#if defined(HAVE_IN6) && defined(AF_INET6) && defined(EPMD6)
#define EPMD_SOCKADDR_IN sockaddr_in6
-#define FAMILY AF_INET6
-
-#define SET_ADDR_LOOPBACK(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin6_family = (af); \
- (addr).sin6_flowinfo = 0; \
- (addr).sin6_addr = in6addr_loopback; \
- (addr).sin6_port = htons(port); \
+#define EPMD_IN_ADDR in6_addr
+#define EPMD_S_ADDR s6_addr
+#define EPMD_ADDR_LOOPBACK in6addr_loopback.s6_addr
+#define EPMD_ADDR_ANY in6addr_any.s6_addr
+#define FAMILY AF_INET6
+
+#define SET_ADDR(dst, addr, port) do { \
+ memset((char*)&(dst), 0, sizeof(dst)); \
+ memcpy((char*)&(dst).sin6_addr.s6_addr, (char*)&(addr), 16); \
+ (dst).sin6_family = AF_INET6; \
+ (dst).sin6_flowinfo = 0; \
+ (dst).sin6_port = htons(port); \
} while(0)
-#define SET_ADDR_ANY(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin6_family = (af); \
- (addr).sin6_flowinfo = 0; \
- (addr).sin6_addr = in6addr_any; \
- (addr).sin6_port = htons(port); \
- } while(0)
+#define IS_ADDR_LOOPBACK(addr) \
+ (memcmp((addr).s6_addr, in6addr_loopback.s6_addr, 16) == 0)
#else /* Not IP v6 */
#define EPMD_SOCKADDR_IN sockaddr_in
-#define FAMILY AF_INET
-
-#define SET_ADDR_LOOPBACK(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin_family = (af); \
- (addr).sin_addr.s_addr = htonl(INADDR_LOOPBACK); \
- (addr).sin_port = htons(port); \
+#define EPMD_IN_ADDR in_addr
+#define EPMD_S_ADDR s_addr
+#define EPMD_ADDR_LOOPBACK htonl(INADDR_LOOPBACK)
+#define EPMD_ADDR_ANY htonl(INADDR_ANY)
+#define FAMILY AF_INET
+
+#define SET_ADDR(dst, addr, port) do { \
+ memset((char*)&(dst), 0, sizeof(dst)); \
+ (dst).sin_family = AF_INET; \
+ (dst).sin_addr.s_addr = (addr); \
+ (dst).sin_port = htons(port); \
} while(0)
-#define SET_ADDR_ANY(addr, af, port) do { \
- memset((char*)&(addr), 0, sizeof(addr)); \
- (addr).sin_family = (af); \
- (addr).sin_addr.s_addr = htonl(INADDR_ANY); \
- (addr).sin_port = htons(port); \
- } while(0)
+#define IS_ADDR_LOOPBACK(addr) ((addr).s_addr == htonl(INADDR_LOOPBACK))
#endif /* Not IP v6 */
@@ -231,6 +229,8 @@
/* Maximum length of a node name == atom name */
#define MAXSYMLEN 255
+#define MAX_LISTEN_SOCKETS 16
+
#define INBUF_SIZE 1024
#define OUTBUF_SIZE 1024
@@ -299,7 +299,8 @@ typedef struct {
Connection *conn;
Nodes nodes;
fd_set orig_read_mask;
- int listenfd;
+ int listenfd[MAX_LISTEN_SOCKETS];
+ char *addresses;
char **argv;
} EpmdVars;
diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c
index 3499ab2934..4d9b454f97 100644
--- a/erts/epmd/src/epmd_srv.c
+++ b/erts/epmd/src/epmd_srv.c
@@ -24,6 +24,10 @@
#include "epmd.h" /* Renamed from 'epmd_r4.h' */
#include "epmd_int.h"
+#ifndef INADDR_NONE
+# define INADDR_NONE 0xffffffff
+#endif
+
/*
*
* This server is a local name server for Erlang nodes. Erlang nodes can
@@ -79,91 +83,157 @@ static void print_names(EpmdVars*);
void run(EpmdVars *g)
{
- int listensock;
+ struct EPMD_SOCKADDR_IN iserv_addr[MAX_LISTEN_SOCKETS];
+ int listensock[MAX_LISTEN_SOCKETS];
+ int num_sockets;
int i;
int opt;
- struct EPMD_SOCKADDR_IN iserv_addr;
+ unsigned short sport = g->port;
node_init(g);
g->conn = conn_init(g);
dbg_printf(g,2,"try to initiate listening port %d", g->port);
-
- if ((listensock = socket(FAMILY,SOCK_STREAM,0)) < 0) {
- dbg_perror(g,"error opening stream socket");
- epmd_cleanup_exit(g,1);
- }
- g->listenfd = listensock;
+
+ if (g->addresses != NULL)
+ {
+ char *tmp;
+ char *token;
+ int loopback_ok = 0;
+
+ if ((tmp = (char *)malloc(strlen(g->addresses) + 1)) == NULL)
+ {
+ dbg_perror(g,"cannot allocate memory");
+ epmd_cleanup_exit(g,1);
+ }
+ strcpy(tmp,g->addresses);
+
+ for(token = strtok(tmp,", "), num_sockets = 0;
+ token != NULL;
+ token = strtok(NULL,", "), num_sockets++)
+ {
+ struct EPMD_IN_ADDR addr;
+#ifdef HAVE_INET_PTON
+ int ret;
+
+ if ((ret = inet_pton(FAMILY,token,&addr)) == -1)
+ {
+ dbg_perror(g,"cannot convert IP address to network format");
+ epmd_cleanup_exit(g,1);
+ }
+ else if (ret == 0)
+#elif !defined(EPMD6)
+ if ((addr.EPMD_S_ADDR = inet_addr(token)) == INADDR_NONE)
+#endif
+ {
+ dbg_tty_printf(g,0,"cannot parse IP address \"%s\"",token);
+ epmd_cleanup_exit(g,1);
+ }
+
+ if (IS_ADDR_LOOPBACK(addr))
+ loopback_ok = 1;
+
+ if (num_sockets - loopback_ok == MAX_LISTEN_SOCKETS - 1)
+ {
+ dbg_tty_printf(g,0,"cannot listen on more than %d IP addresses",
+ MAX_LISTEN_SOCKETS);
+ epmd_cleanup_exit(g,1);
+ }
+
+ SET_ADDR(iserv_addr[num_sockets],addr.EPMD_S_ADDR,sport);
+ }
+
+ free(tmp);
+
+ if (!loopback_ok)
+ {
+ SET_ADDR(iserv_addr[num_sockets],EPMD_ADDR_LOOPBACK,sport);
+ num_sockets++;
+ }
+ }
+ else
+ {
+ SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport);
+ num_sockets = 1;
+ }
+
+#if !defined(__WIN32__)
+ /* We ignore the SIGPIPE signal that is raised when we call write
+ twice on a socket closed by the other end. */
+ signal(SIGPIPE, SIG_IGN);
+#endif
/*
* Initialize number of active file descriptors.
* Stdin, stdout, and stderr are still open.
- * One for the listen socket.
*/
- g->active_conn = 3+1;
+ g->active_conn = 3 + num_sockets;
+ g->max_conn -= num_sockets;
+
+ FD_ZERO(&g->orig_read_mask);
+
+ for (i = 0; i < num_sockets; i++)
+ {
+ if ((listensock[i] = socket(FAMILY,SOCK_STREAM,0)) < 0)
+ {
+ dbg_perror(g,"error opening stream socket");
+ epmd_cleanup_exit(g,1);
+ }
+ g->listenfd[i] = listensock[i];
- /*
- * Note that we must not enable the SO_REUSEADDR on Windows,
- * because addresses will be reused even if they are still in use.
- */
+ /*
+ * Note that we must not enable the SO_REUSEADDR on Windows,
+ * because addresses will be reused even if they are still in use.
+ */
#if !defined(__WIN32__)
- /* We ignore the SIGPIPE signal that is raised when we call write
- twice on a socket closed by the other end. */
- signal(SIGPIPE, SIG_IGN);
-
- opt = 1; /* Set this option */
- if (setsockopt(listensock,SOL_SOCKET,SO_REUSEADDR,(char* ) &opt,
- sizeof(opt)) <0) {
- dbg_perror(g,"can't set sockopt");
- epmd_cleanup_exit(g,1);
- }
+ opt = 1;
+ if (setsockopt(listensock[i],SOL_SOCKET,SO_REUSEADDR,(char* ) &opt,
+ sizeof(opt)) <0)
+ {
+ dbg_perror(g,"can't set sockopt");
+ epmd_cleanup_exit(g,1);
+ }
#endif
- /* In rare cases select returns because there is someone
- to accept but the request is withdrawn before the
- accept function is called. We set the listen socket
- to be non blocking to prevent us from being hanging
- in accept() waiting for the next request. */
+ /* In rare cases select returns because there is someone
+ to accept but the request is withdrawn before the
+ accept function is called. We set the listen socket
+ to be non blocking to prevent us from being hanging
+ in accept() waiting for the next request. */
#if (defined(__WIN32__) || defined(NO_FCNTL))
- opt = 1;
- if (ioctl(listensock, FIONBIO, &opt) != 0) /* Gives warning in VxWorks */
+ opt = 1;
+ /* Gives warning in VxWorks */
+ if (ioctl(listensock[i], FIONBIO, &opt) != 0)
#else
- opt = fcntl(listensock, F_GETFL, 0);
- if (fcntl(listensock, F_SETFL, opt | O_NONBLOCK) == -1)
+ opt = fcntl(listensock[i], F_GETFL, 0);
+ if (fcntl(listensock[i], F_SETFL, opt | O_NONBLOCK) == -1)
#endif /* __WIN32__ || VXWORKS */
- dbg_perror(g,"failed to set non-blocking mode of listening socket %d",
- listensock);
+ dbg_perror(g,"failed to set non-blocking mode of listening socket %d",
+ listensock[i]);
- { /* store port number in unsigned short */
- unsigned short sport = g->port;
- SET_ADDR_ANY(iserv_addr, FAMILY, sport);
- }
-
- if(bind(listensock,(struct sockaddr*) &iserv_addr, sizeof(iserv_addr)) < 0 )
- {
- if (errno == EADDRINUSE)
+ if (bind(listensock[i], (struct sockaddr*) &iserv_addr[i],
+ sizeof(iserv_addr[i])) < 0)
{
- dbg_tty_printf(g,1,"there is already a epmd running at port %d",
- g->port);
- epmd_cleanup_exit(g,0);
- }
- else
- {
- dbg_perror(g,"failed to bind socket");
- epmd_cleanup_exit(g,1);
+ if (errno == EADDRINUSE)
+ {
+ dbg_tty_printf(g,1,"there is already a epmd running at port %d",
+ g->port);
+ epmd_cleanup_exit(g,0);
+ }
+ else
+ {
+ dbg_perror(g,"failed to bind socket");
+ epmd_cleanup_exit(g,1);
+ }
}
- }
-
- dbg_printf(g,2,"starting");
- if(listen(listensock, SOMAXCONN) < 0) {
- dbg_perror(g,"failed to listen on socket");
- epmd_cleanup_exit(g,1);
- }
-
- FD_ZERO(&g->orig_read_mask);
- FD_SET(listensock,&g->orig_read_mask);
+ if(listen(listensock[i], SOMAXCONN) < 0) {
+ dbg_perror(g,"failed to listen on socket");
+ epmd_cleanup_exit(g,1);
+ }
+ FD_SET(listensock[i],&g->orig_read_mask);
+ }
dbg_tty_printf(g,2,"entering the main select() loop");
@@ -200,17 +270,18 @@ void run(EpmdVars *g)
sleep(g->delay_accept);
}
- if (FD_ISSET(listensock,&read_mask)) {
- if (do_accept(g, listensock) && g->active_conn < g->max_conn) {
- /*
- * The accept() succeeded, and we have at least one file
- * descriptor still free, which means that another accept()
- * could succeed. Go do do another select(), in case there
- * are more incoming connections waiting to be accepted.
- */
- goto select_again;
+ for (i = 0; i < num_sockets; i++)
+ if (FD_ISSET(listensock[i],&read_mask)) {
+ if (do_accept(g, listensock[i]) && g->active_conn < g->max_conn) {
+ /*
+ * The accept() succeeded, and we have at least one file
+ * descriptor still free, which means that another accept()
+ * could succeed. Go do do another select(), in case there
+ * are more incoming connections waiting to be accepted.
+ */
+ goto select_again;
+ }
}
- }
/* Check all open streams marked by select for data or a
close. We also close all open sockets except ALIVE
@@ -738,6 +809,7 @@ static int conn_open(EpmdVars *g,int fd)
for (i = 0; i < g->max_conn; i++) {
if (g->conn[i].open == EPMD_FALSE) {
struct sockaddr_in si;
+ struct sockaddr_in di;
#ifdef HAVE_SOCKLEN_T
socklen_t st;
#else
@@ -758,12 +830,16 @@ static int conn_open(EpmdVars *g,int fd)
/* Determine if connection is from localhost */
if (getpeername(s->fd,(struct sockaddr*) &si,&st) ||
st < sizeof(si)) {
- /* Failure to get peername is regarder as non local host */
+ /* Failure to get peername is regarded as non local host */
s->local_peer = EPMD_FALSE;
} else {
+ /* Only 127.x.x.x and connections from the host's IP address
+ allowed, no false positives */
s->local_peer =
- ((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) ==
- 0x7F000000U); /* Only 127.x.x.x allowed, no false positives */
+ (((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) ==
+ 0x7F000000U) ||
+ (getsockname(s->fd,(struct sockaddr*) &di,&st) ?
+ EPMD_FALSE : si.sin_addr.s_addr == di.sin_addr.s_addr));
}
dbg_tty_printf(g,2,(s->local_peer) ? "Local peer connected" :
"Non-local peer connected");
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index 778b3569c7..7a5746e630 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -727,16 +727,16 @@ static int
heart_cmd_reply(int fd, char *s)
{
struct msg m;
- int len = strlen(s) + 1; /* Include \0 */
+ int len = strlen(s);
/* if s >= MSG_BODY_SIZE, return a write
* failure immediately.
*/
- if (len > sizeof(m.fill))
+ if (len >= sizeof(m.fill))
return -1;
m.op = HEART_CMD;
- m.len = htons(len + 2); /* Include Op */
+ m.len = htons(len + 1); /* Include Op */
strcpy((char*)m.fill, s);
return write_message(fd, &m);
diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c
index 886b301997..b7c3c956c6 100644
--- a/erts/etc/unix/to_erl.c
+++ b/erts/etc/unix/to_erl.c
@@ -125,7 +125,7 @@ static void usage(char *pname)
int main(int argc, char **argv)
{
char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX];
- int i, len, wfd, rfd, result = 0;
+ int i, len, wfd, rfd;
fd_set readfds;
char buf[BUFSIZ];
char pipename[FILENAME_MAX];
@@ -367,7 +367,6 @@ int main(int argc, char **argv)
}
else {
fprintf(stderr, "Error in select.\n");
- result = -1;
break;
}
}
@@ -398,7 +397,6 @@ int main(int argc, char **argv)
close(wfd);
if (len < 0) {
fprintf(stderr, "Error in reading from stdin.\n");
- result = -1;
} else {
fprintf(stderr, "[EOF]\n\r");
}
@@ -420,7 +418,6 @@ int main(int argc, char **argv)
fprintf(stderr, "Error in writing to FIFO.\n");
close(rfd);
close(wfd);
- result = -1;
break;
}
STATUS("\" OK\r\n");
@@ -447,7 +444,6 @@ int main(int argc, char **argv)
close(wfd);
if (len < 0) {
fprintf(stderr, "Error in reading from FIFO.\n");
- result = -1;
} else
fprintf(stderr, "[End]\n\r");
break;
@@ -456,7 +452,6 @@ int main(int argc, char **argv)
if ((len=version_handshake(buf,len,wfd)) < 0) {
close(rfd);
close(wfd);
- result = -1;
break;
}
if (protocol_ver >= 1) {
@@ -475,7 +470,6 @@ int main(int argc, char **argv)
fprintf(stderr, "Error in writing to terminal.\n");
close(rfd);
close(wfd);
- result = -1;
break;
}
STATUS("\" OK\r\n");
diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c
index bd3d38e649..968d563325 100644
--- a/erts/lib_src/common/erl_printf_format.c
+++ b/erts/lib_src/common/erl_printf_format.c
@@ -1,7 +1,7 @@
/*
* %CopyrightBegin%
*
- * Copyright Ericsson AB 2005-2009. All Rights Reserved.
+ * Copyright Ericsson AB 2005-2011. All Rights Reserved.
*
* The contents of this file are subject to the Erlang Public License,
* Version 1.1, (the "License"); you may not use this file except in
@@ -27,7 +27,7 @@
* length: hh | h | l | ll | L | j | t | b<sz>
* conversion: d,i | o,u,x,X | e,E | f,F | g,G | a,A | c | s | T |
* p | n | %
- * sz: 8 | 16 | 32 | 64 | p
+ * sz: 8 | 16 | 32 | 64 | p | e
*/
/* Without this, variable argument lists break on VxWorks */
@@ -76,6 +76,18 @@
#endif
#endif
+#ifndef ERTS_SIZEOF_ETERM
+# ifdef HALFWORD_HEAP_EMULATOR
+# if SIZEOF_VOID_P == 8
+# define ERTS_SIZEOF_ETERM 4
+# else
+# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture"
+# endif
+# else
+# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P
+# endif
+#endif
+
#if defined(__GNUC__)
# undef inline
# define inline __inline__
@@ -520,6 +532,17 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap)
#error No integer datatype with the same size as 'void *' found
#endif
}
+ else if (*ptr == 'e') {
+ ptr++;
+#if SIZEOF_INT == ERTS_SIZEOF_ETERM
+#elif SIZEOF_LONG == ERTS_SIZEOF_ETERM
+ fmt |= FMTL_l;
+#elif SIZEOF_LONG_LONG == ERTS_SIZEOF_ETERM
+ fmt |= FMTL_ll;
+#else
+#error No integer datatype with the same size as Eterm found
+#endif
+ }
else {
int bits = 0;
while(isdigit((int) *ptr))
diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam
index 4a75e43e73..c2ae01d0d5 100644
--- a/erts/preloaded/ebin/prim_file.beam
+++ b/erts/preloaded/ebin/prim_file.beam
Binary files differ
diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl
index 10be852e92..fb0aef8947 100644
--- a/erts/preloaded/src/prim_file.erl
+++ b/erts/preloaded/src/prim_file.erl
@@ -64,7 +64,7 @@
-include("file.hrl").
-define(DRV, efile).
--define(FD_DRV, efile).
+-define(FD_DRV, "efile").
-define(LARGEFILESIZE, (1 bsl 63)).
@@ -506,7 +506,7 @@ read_file(_) ->
%% Takes a Port opened with open/1.
read_file(Port, File) when is_port(Port),
- (is_list(File) orelse is_binary(File))->
+ (is_list(File) orelse is_binary(File)) ->
Cmd = [?FILE_READ_FILE | pathname(File)],
case drv_command(Port, Cmd) of
{error, enomem} ->
@@ -832,7 +832,7 @@ drv_open(Driver, Portopts) ->
{ok, Port}
catch
error:Reason ->
- {error,Reason}
+ {error, Reason}
end.
@@ -1041,8 +1041,8 @@ translate_response(?FILE_RESP_NUMBER, List) ->
{N, []} = get_uint64(List),
{ok, N};
translate_response(?FILE_RESP_DATA, List) ->
- {N, Data} = get_uint64(List),
- {ok, {N, Data}};
+ {_N, _Data} = ND = get_uint64(List),
+ {ok, ND};
translate_response(?FILE_RESP_INFO, List) when is_list(List) ->
{ok, transform_info_ints(get_uint32s(List))};
translate_response(?FILE_RESP_NUMERR, L0) ->
@@ -1087,10 +1087,8 @@ translate_response(?FILE_RESP_FNAME, Data) when is_binary(Data) ->
{ok, prim_file:internal_native2name(Data)};
translate_response(?FILE_RESP_FNAME, Data) ->
{ok, Data};
-
translate_response(?FILE_RESP_ALL_DATA, Data) ->
{ok, Data};
-
translate_response(X, Data) ->
{error, {bad_response_from_port, [X | Data]}}.
@@ -1137,14 +1135,14 @@ date_to_bytes(undefined) ->
date_to_bytes({{Y, Mon, D}, {H, Min, S}}) ->
<<Y:32, Mon:32, D:32, H:32, Min:32, S:32>>.
-% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) ->
-% (uint32(Y1) bsl 32) bor uint32(Y2).
+%% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) ->
+%% (uint32(Y1) bsl 32) bor uint32(Y2).
-% uint64(X1, X2, X3, X4, X5, X6, X7, X8) ->
-% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8).
+%% uint64(X1, X2, X3, X4, X5, X6, X7, X8) ->
+%% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8).
-% uint32([X1,X2,X3,X4]) ->
-% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
+%% uint32([X1,X2,X3,X4]) ->
+%% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
uint32(X1,X2,X3,X4) ->
(X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4.
diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml
index 1ee73b890b..c92566de37 100644
--- a/lib/common_test/doc/src/common_test_app.xml
+++ b/lib/common_test/doc/src/common_test_app.xml
@@ -296,7 +296,7 @@
</func>
<func>
- <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {skip,Reason}</name>
+ <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {fail,Reason} | {skip,Reason}</name>
<fsummary>Test case initialization.</fsummary>
<type>
<v> TestCase = atom()</v>
@@ -311,10 +311,12 @@
<p>This function is called before each test case. The
<c>TestCase</c> argument is the name of the test case, and
- <c>Config</c> is the configuration which can be modified
- here. Whatever is returned from this function is given as
- <c>Config</c> to the test case. If <c>{skip,Reason}</c> is returned,
- the test case will be skipped and <c>Reason</c> printed
+ <c>Config</c> (list of key-value tuples) is the configuration
+ data that can be modified here. The <c>NewConfig</c> list returned
+ from this function is given as <c>Config</c> to the test case.
+ If <c>{fail,Reason}</c> is returned, the test case is
+ marked as failed without being executed. If <c>{skip,Reason}</c> is
+ returned, the test case will be skipped and <c>Reason</c> printed
in the overview log for the suite.</p>
</desc>
</func>
diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml
index 723492d8f3..3f9fdb7121 100644
--- a/lib/common_test/doc/src/write_test_chapter.xml
+++ b/lib/common_test/doc/src/write_test_chapter.xml
@@ -167,12 +167,16 @@
returning <c>{fail,Reason}</c>, nor will it be able to save data with
<c>{save_config,Data}</c>.</p>
- <p>If <c>init_per_testcase</c> crashes, the test case itself is skipped
+ <p>If <c>init_per_testcase</c> crashes, the test case itself gets skipped
automatically (so called <em>auto skipped</em>). If <c>init_per_testcase</c>
- returns a <c>skip</c> tuple, also then will the test case be skipped (so
- called <em>user skipped</em>). In either event, the <c>end_per_testcase</c> is
- never called.
+ returns a tuple <c>{skip,Reason}</c>, also then the test case gets skipped
+ (so called <em>user skipped</em>). It is also possible, by returning a tuple
+ <c>{fail,Reason}</c> from <c>init_per_testcase</c>, to mark the test case
+ as failed without actually executing it.
</p>
+ <note><p>If <c>init_per_testcase</c> crashes, or returns <c>{skip,Reason}</c>
+ or <c>{fail,Reason}</c>, the <c>end_per_testcase</c> function is not called.
+ </p></note>
<p>If it is determined during execution of <c>end_per_testcase</c> that
the status of a successful test case should be changed to failed,
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index dfec2b7a67..66da3ef742 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -861,6 +861,7 @@ remove_config(Callback, Config) ->
%%%
%%% @doc <p>Use this function to set a new timetrap for the running test case.</p>
timetrap(Time) ->
+ test_server:timetrap_cancel(),
test_server:timetrap(Time).
%%%-----------------------------------------------------------------
diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl
index 38a2aa53ac..c016b9c66b 100644
--- a/lib/common_test/src/ct_framework.erl
+++ b/lib/common_test/src/ct_framework.erl
@@ -24,7 +24,7 @@
-module(ct_framework).
--export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
+-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, report/2, warn/1]).
-export([error_notification/4]).
-export([overview_html_header/1]).
@@ -434,6 +434,9 @@ try_set_default(Name,Key,Info,Where) ->
%%%
%%% @doc Test server framework callback, called by the test_server
%%% when a test case is finished.
+end_tc(Mod, Fun, Args) ->
+ %% Have to keep end_tc/3 for backwards compatabilty issues
+ end_tc(Mod, Fun, Args, '$end_tc_dummy').
end_tc(?MODULE,error_in_suite,_, _) -> % bad start!
ok;
end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) ->
@@ -490,9 +493,9 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) ->
case ct_hooks:end_tc(
Mod, FuncSpec, Args, Result, Return) of
'$ct_no_change' ->
- {FinalResult = ok,Result};
- FinalResult ->
- {FinalResult,FinalResult}
+ {ok,Result};
+ FinalResult1 ->
+ {FinalResult1,FinalResult1}
end,
% send sync notification so that event handlers may print
% in the log file before it gets closed
@@ -734,7 +737,7 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) ->
%% (and only) test case so we can report Error properly
[{?MODULE,error_in_suite,[[Error]]}];
[] ->
- {error,{invalid_group_spec,Name}};
+ [];
ConfTests ->
case lists:member(skipped, Props) of
true ->
@@ -764,23 +767,7 @@ get_suite(Mod, Name) ->
find_groups(Mod, Name, TCs, GroupDefs) ->
Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false),
- Trimmed = trim(Found),
- %% I cannot find a reason to why this function is called,
- %% It deletes any group which is referenced in any other
- %% group. i.e.
- %% groups() ->
- %% [{test, [], [testcase1]},
- %% {testcases, [], [{group, test}]}].
- %% Would be changed to
- %% groups() ->
- %% [{testcases, [], [testcase1]}].
- %% instead of what I believe is correct:
- %% groups() ->
- %% [{test, [], [testcase1]},
- %% {testcases, [], [testcase1]}].
- %% Have to double check with peppe
- delete_subs(Trimmed, Trimmed),
- Trimmed.
+ trim(Found).
find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _)
when is_atom(Name), is_list(Props), is_list(Tests) ->
@@ -1170,12 +1157,14 @@ error_in_suite(Config) ->
%% if the group config functions are missing in the suite,
%% use these instead
ct_init_per_group(GroupName, Config) ->
- ct_logs:log("WARNING", "init_per_group/2 for ~w missing in suite, using default.",
+ ct_logs:log("WARNING", "init_per_group/2 for ~w missing "
+ "in suite, using default.",
[GroupName]),
Config.
ct_end_per_group(GroupName, _) ->
- ct_logs:log("WARNING", "end_per_group/2 for ~w missing in suite, using default.",
+ ct_logs:log("WARNING", "end_per_group/2 for ~w missing "
+ "in suite, using default.",
[GroupName]),
ok.
@@ -1184,6 +1173,13 @@ ct_end_per_group(GroupName, _) ->
%%% @spec report(What,Data) -> ok
report(What,Data) ->
case What of
+ loginfo ->
+ %% logfiles and direcories have been created for a test and the
+ %% top level test index page needs to be refreshed
+ TestName = filename:basename(proplists:get_value(topdir, Data), ".logs"),
+ RunDir = proplists:get_value(rundir, Data),
+ ct_logs:make_all_suites_index({TestName,RunDir}),
+ ok;
tests_start ->
case ct_util:get_testdata(cover) of
undefined ->
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index f8ace73cbf..ba4adb8683 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -97,11 +97,11 @@ logdir_node_prefix() ->
logdir_prefix()++"."++atom_to_list(node()).
%%%-----------------------------------------------------------------
-%%% @spec close(How) -> ok
+%%% @spec close(Info) -> ok
%%%
%%% @doc Create index pages with test results and close the CT Log
%%% (tool-internal use only).
-close(How) ->
+close(Info) ->
make_last_run_index(),
ct_event:notify(#event{name=stop_logging,node=node(),data=[]}),
@@ -118,7 +118,7 @@ close(How) ->
ok
end,
- if How == clean ->
+ if Info == clean ->
case cleanup() of
ok ->
ok;
@@ -427,8 +427,8 @@ logger(Parent,Mode) ->
file:make_dir(Dir),
ct_event:notify(#event{name=start_logging,node=node(),
data=?abs(Dir)}),
- make_all_suites_index(start),
make_all_runs_index(start),
+ make_all_suites_index(start),
case Mode of
interactive -> interactive_link();
_ -> ok
@@ -796,24 +796,29 @@ make_one_index_entry(SuiteName, LogDir, Label, All, Missing) ->
{Succ,Fail,UserSkip,AutoSkip} ->
NotBuilt = not_built(SuiteName, LogDir, All, Missing),
NewResult = make_one_index_entry1(SuiteName, LogDir, Label, Succ, Fail,
- UserSkip, AutoSkip, NotBuilt, All),
+ UserSkip, AutoSkip, NotBuilt, All,
+ normal),
{NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt};
error ->
error
end.
make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip,
- NotBuilt, All) ->
+ NotBuilt, All, Mode) ->
LogFile = filename:join(Link, ?suitelog_name ++ ".html"),
- CrashDumpName = SuiteName ++ "_erl_crash.dump",
- CrashDumpLink =
- case filelib:is_file(CrashDumpName) of
- true ->
- ["&nbsp;<A HREF=\"", CrashDumpName,
- "\">(CrashDump)</A>"];
- false ->
- ""
- end,
+ CrashDumpLink = case Mode of
+ cached ->
+ "";
+ normal ->
+ CrashDumpName = SuiteName ++ "_erl_crash.dump",
+ case filelib:is_file(CrashDumpName) of
+ true ->
+ ["&nbsp;<A HREF=\"", CrashDumpName,
+ "\">(CrashDump)</A>"];
+ false ->
+ ""
+ end
+ end,
{Lbl,Timestamp,Node,AllInfo} =
case All of
{true,OldRuns} ->
@@ -975,9 +980,13 @@ index_header(Label, StartTime) ->
"<th>Missing<br>Suites</th>\n"
"\n"]].
+
all_suites_index_header() ->
{ok,Cwd} = file:get_cwd(),
- LogDir = filename:basename(Cwd),
+ all_suites_index_header(Cwd).
+
+all_suites_index_header(IndexDir) ->
+ LogDir = filename:basename(IndexDir),
AllRuns = "All test runs in \"" ++ LogDir ++ "\"",
[header("Test Results") |
["<CENTER>\n",
@@ -1414,15 +1423,72 @@ timestamp(Dir) ->
[S,Min,H,D,M,Y] = [list_to_integer(N) || N <- lists:sublist(TsR,6)],
format_time({{Y,M,D},{H,Min,S}}).
-make_all_suites_index(When) ->
+%% ----------------------------- NOTE --------------------------------------
+%% The top level index file is generated based on the file contents under
+%% logdir. This takes place initially when the test run starts (When = start)
+%% and an update takes place at the end of the test run, or when the user
+%% requests an explicit refresh (When = refresh).
+%% The index file needs to be updated also at the start of each individual
+%% test (in order for the user to be able to track test progress by refreshing
+%% the browser). Since it would be too expensive to generate a new file from
+%% scratch every time (by reading the data from disk), a copy of the dir tree
+%% is cached as a result of the first index file creation. This copy is then
+%% used for all top level index page updates that occur during the test run.
+%% This means that any changes to the dir tree under logdir during the test
+%% run will not show until after the final refresh.
+%% -------------------------------------------------------------------------
+
+%% Creates the top level index file. When == start | refresh.
+%% A copy of the dir tree under logdir is cached as a result.
+make_all_suites_index(When) when is_atom(When) ->
AbsIndexName = ?abs(?index_name),
notify_and_lock_file(AbsIndexName),
LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext),
- Sorted = sort_logdirs(LogDirs,[]),
- Result = make_all_suites_index1(When,Sorted),
+ Sorted = sort_logdirs(LogDirs, []),
+ Result = make_all_suites_index1(When, AbsIndexName, Sorted),
notify_and_unlock_file(AbsIndexName),
- Result.
-
+ Result;
+
+%% This updates the top level index file using cached data from
+%% the initial index file creation.
+make_all_suites_index(NewTestData = {_TestName,DirName}) ->
+ %% AllLogDirs = [{TestName,Label,Missing,{LastLogDir,Summary},OldDirs}|...]
+ {AbsIndexName,LogDirData} = ct_util:get_testdata(test_index),
+
+ CtRunDirPos = length(filename:split(AbsIndexName)),
+ CtRunDir = filename:join(lists:sublist(filename:split(DirName),
+ CtRunDirPos)),
+
+ Label = case read_totals_file(filename:join(CtRunDir, ?totals_name)) of
+ {_,"-",_,_} -> "...";
+ {_,Lbl,_,_} -> Lbl;
+ _ -> "..."
+ end,
+ notify_and_lock_file(AbsIndexName),
+ Result =
+ case catch make_all_suites_ix_cached(AbsIndexName,
+ NewTestData,
+ Label,
+ LogDirData) of
+ {'EXIT',Reason} ->
+ io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
+ io:format("~p~n", [Reason]),
+ {error,Reason};
+ {error,Reason} ->
+ io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
+ io:format("~p~n", [Reason]),
+ {error,Reason};
+ ok ->
+ ok;
+ Err ->
+ io:format("Unknown internal error while updating ~s. "
+ "Please report.\n(Err: ~p, ID: 1)",
+ [AbsIndexName,Err]),
+ {error, Err}
+ end,
+ notify_and_unlock_file(AbsIndexName),
+ Result.
+
sort_logdirs([Dir|Dirs],Groups) ->
TestName = filename:rootname(filename:basename(Dir)),
case filelib:wildcard(filename:join(Dir,"run.*")) of
@@ -1448,13 +1514,12 @@ sort_each_group([{Test,IxDirs}|Groups]) ->
sort_each_group([]) ->
[].
-make_all_suites_index1(When,AllSuitesLogDirs) ->
+make_all_suites_index1(When, AbsIndexName, AllLogDirs) ->
IndexName = ?index_name,
- AbsIndexName = ?abs(IndexName),
if When == start -> ok;
true -> io:put_chars("Updating " ++ AbsIndexName ++ "... ")
end,
- case catch make_all_suites_index2(IndexName,AllSuitesLogDirs) of
+ case catch make_all_suites_index2(IndexName, AllLogDirs) of
{'EXIT', Reason} ->
io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
io:format("~p~n", [Reason]),
@@ -1463,11 +1528,16 @@ make_all_suites_index1(When,AllSuitesLogDirs) ->
io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
io:format("~p~n", [Reason]),
{error, Reason};
- ok ->
- if When == start -> ok;
- true -> io:put_chars("done\n")
- end,
- ok;
+ {ok,CacheData} ->
+ case When of
+ start ->
+ ct_util:set_testdata_async({test_index,{AbsIndexName,
+ CacheData}}),
+ ok;
+ _ ->
+ io:put_chars("done\n"),
+ ok
+ end;
Err ->
io:format("Unknown internal error while updating ~s. "
"Please report.\n(Err: ~p, ID: 1)",
@@ -1475,56 +1545,124 @@ make_all_suites_index1(When,AllSuitesLogDirs) ->
{error, Err}
end.
-make_all_suites_index2(IndexName,AllSuitesLogDirs) ->
- {ok,Index0,_Totals} = make_all_suites_index3(AllSuitesLogDirs,
- all_suites_index_header(),
- 0, 0, 0, 0, 0, []),
+make_all_suites_index2(IndexName, AllTestLogDirs) ->
+ {ok,Index0,_Totals,CacheData} =
+ make_all_suites_index3(AllTestLogDirs,
+ all_suites_index_header(),
+ 0, 0, 0, 0, 0, [], []),
Index = [Index0|index_footer()],
case force_write_file(IndexName, Index) of
ok ->
- ok;
+ {ok,CacheData};
{error, Reason} ->
{error,{index_write_error, Reason}}
end.
-make_all_suites_index3([{SuiteName,[LastLogDir|OldDirs]}|Rest],
+make_all_suites_index3([{TestName,[LastLogDir|OldDirs]}|Rest],
Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt,
- Labels) ->
+ Labels, CacheData) ->
[EntryDir|_] = filename:split(LastLogDir),
Missing =
- case file:read_file(filename:join(EntryDir,?missing_suites_info)) of
+ case file:read_file(filename:join(EntryDir, ?missing_suites_info)) of
{ok,Bin} -> binary_to_term(Bin);
_ -> []
end,
{Label,Labels1} =
case proplists:get_value(EntryDir, Labels) of
undefined ->
- case read_totals_file(filename:join(EntryDir,?totals_name)) of
+ case read_totals_file(filename:join(EntryDir, ?totals_name)) of
{_,Lbl,_,_} -> {Lbl,[{EntryDir,Lbl}|Labels]};
_ -> {"-",[{EntryDir,"-"}|Labels]}
end;
Lbl ->
{Lbl,Labels}
end,
- case make_one_index_entry(SuiteName, LastLogDir, Label, {true,OldDirs}, Missing) of
+ case make_one_index_entry(TestName, LastLogDir, Label, {true,OldDirs}, Missing) of
{Result1,Succ,Fail,USkip,ASkip,NotBuilt} ->
%% for backwards compatibility
AutoSkip1 = case catch AutoSkip+ASkip of
{'EXIT',_} -> undefined;
Res -> Res
end,
+ IxEntry = {TestName,Label,Missing,
+ {LastLogDir,{Succ,Fail,USkip,ASkip}},OldDirs},
make_all_suites_index3(Rest, [Result|Result1], TotSucc+Succ,
TotFail+Fail, UserSkip+USkip, AutoSkip1,
- TotNotBuilt+NotBuilt,Labels1);
+ TotNotBuilt+NotBuilt, Labels1,
+ [IxEntry|CacheData]);
error ->
+ IxEntry = {TestName,Label,Missing,{LastLogDir,error},OldDirs},
make_all_suites_index3(Rest, Result, TotSucc, TotFail,
- UserSkip, AutoSkip, TotNotBuilt,Labels1)
+ UserSkip, AutoSkip, TotNotBuilt, Labels1,
+ [IxEntry|CacheData])
end;
make_all_suites_index3([], Result, TotSucc, TotFail, UserSkip, AutoSkip,
- TotNotBuilt,_) ->
+ TotNotBuilt, _, CacheData) ->
{ok, [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt,true)],
- {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}}.
+ {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}, lists:reverse(CacheData)}.
+
+
+make_all_suites_ix_cached(AbsIndexName, NewTestData, Label, AllTestLogDirs) ->
+ AllTestLogDirs1 = insert_new_test_data(NewTestData, Label, AllTestLogDirs),
+ IndexDir = filename:dirname(AbsIndexName),
+ Index0 = make_all_suites_ix_cached1(AllTestLogDirs1,
+ all_suites_index_header(IndexDir),
+ 0, 0, 0, 0, 0),
+ Index = [Index0|index_footer()],
+ case force_write_file(AbsIndexName, Index) of
+ ok ->
+ ok;
+ {error, Reason} ->
+ {error,{index_write_error, Reason}}
+ end.
+
+insert_new_test_data({NewTestName,NewTestDir}, NewLabel, AllTestLogDirs) ->
+ AllTestLogDirs1 =
+ case lists:keysearch(NewTestName, 1, AllTestLogDirs) of
+ {value,{_,_,_,{LastLogDir,_},OldDirs}} ->
+ [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}},
+ [LastLogDir|OldDirs]} |
+ lists:keydelete(NewTestName, 1, AllTestLogDirs)];
+ false ->
+ [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}},[]} |
+ AllTestLogDirs]
+ end,
+ lists:keysort(1, AllTestLogDirs1).
+
+make_all_suites_ix_cached1([{TestName,Label,Missing,LastLogDirData,OldDirs}|Rest],
+ Result, TotSucc, TotFail, UserSkip, AutoSkip,
+ TotNotBuilt) ->
+ case make_one_ix_entry_cached(TestName, LastLogDirData,
+ Label, {true,OldDirs}, Missing) of
+ {Result1,Succ,Fail,USkip,ASkip,NotBuilt} ->
+ %% for backwards compatibility
+ AutoSkip1 = case catch AutoSkip+ASkip of
+ {'EXIT',_} -> undefined;
+ Res -> Res
+ end,
+ make_all_suites_ix_cached1(Rest, [Result|Result1], TotSucc+Succ,
+ TotFail+Fail, UserSkip+USkip, AutoSkip1,
+ TotNotBuilt+NotBuilt);
+ error ->
+ make_all_suites_ix_cached1(Rest, Result, TotSucc, TotFail,
+ UserSkip, AutoSkip, TotNotBuilt)
+ end;
+make_all_suites_ix_cached1([], Result, TotSucc, TotFail, UserSkip, AutoSkip,
+ TotNotBuilt) ->
+ [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, true)].
+
+make_one_ix_entry_cached(TestName, {LogDir,Summary}, Label, All, Missing) ->
+ case Summary of
+ {Succ,Fail,UserSkip,AutoSkip} ->
+ NotBuilt = not_built(TestName, LogDir, All, Missing),
+ NewResult = make_one_index_entry1(TestName, LogDir, Label,
+ Succ, Fail, UserSkip, AutoSkip,
+ NotBuilt, All, cached),
+ {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt};
+ error ->
+ error
+ end.
%%-----------------------------------------------------------------
%% Remove log files.
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 7bd7dc7d66..c01e97b358 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -262,15 +262,15 @@ run_or_refresh(StartOpts = #opts{logdir = LogDir}, Args) ->
%% give the shell time to print version etc
timer:sleep(500),
io:nl(),
- case catch ct_logs:make_all_suites_index(refresh) of
- {'EXIT',ASReason} ->
+ case catch ct_logs:make_all_runs_index(refresh) of
+ {'EXIT',ARReason} ->
file:set_cwd(Cwd),
- {error,{all_suites_index,ASReason}};
+ {error,{all_runs_index,ARReason}};
_ ->
- case catch ct_logs:make_all_runs_index(refresh) of
- {'EXIT',ARReason} ->
+ case catch ct_logs:make_all_suites_index(refresh) of
+ {'EXIT',ASReason} ->
file:set_cwd(Cwd),
- {error,{all_runs_index,ARReason}};
+ {error,{all_suites_index,ASReason}};
_ ->
file:set_cwd(Cwd),
io:format("Logs in ~s refreshed!~n~n", [LogDir1]),
@@ -1111,6 +1111,8 @@ run(TestDirs) ->
install([]),
reformat_result(catch do_run(tests(TestDirs), [])).
+reformat_result({'EXIT',{user_error,Reason}}) ->
+ {error,Reason};
reformat_result({user_error,Reason}) ->
{error,Reason};
reformat_result(Result) ->
diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl
index 115207beed..b3e345b4e5 100644
--- a/lib/common_test/src/ct_util.erl
+++ b/lib/common_test/src/ct_util.erl
@@ -37,7 +37,7 @@
read_suite_data/1,
delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1,
delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1,
- update_testdata/2]).
+ set_testdata_async/1, update_testdata/2]).
-export([override_silence_all_connections/0, override_silence_connections/1,
get_overridden_silenced_connections/0,
@@ -96,7 +96,8 @@ start(Mode,LogDir) ->
Pid = spawn_link(fun() -> do_start(S,Mode,LogDir) end),
receive
{Pid,started} -> Pid;
- {Pid,Error} -> exit(Error)
+ {Pid,Error} -> exit(Error);
+ {_Ref,{Pid,Error}} -> exit(Error)
end;
Pid ->
case get_mode() of
@@ -162,21 +163,19 @@ do_start(Parent,Mode,LogDir) ->
end,
{StartTime,TestLogDir} = ct_logs:init(Mode),
- %% Initiate ct_hooks
+ ct_event:notify(#event{name=test_start,
+ node=node(),
+ data={StartTime,
+ lists:flatten(TestLogDir)}}),
+ %% Initialize ct_hooks
case catch ct_hooks:init(Opts) of
ok ->
- ok;
+ Parent ! {self(),started};
{_,CTHReason} ->
ct_logs:tc_print('Suite Callback',CTHReason,[]),
- Parent ! {self(), CTHReason},
- self() ! {{stop,normal},{self(),make_ref()}}
+ self() ! {{stop,{self(),{user_error,CTHReason}}},
+ {Parent,make_ref()}}
end,
-
- ct_event:notify(#event{name=test_start,
- node=node(),
- data={StartTime,
- lists:flatten(TestLogDir)}}),
- Parent ! {self(),started},
loop(Mode,[],StartDir).
create_table(TableName,KeyPos) ->
@@ -232,6 +231,9 @@ update_testdata(Key, Fun) ->
set_testdata(TestData) ->
call({set_testdata, TestData}).
+set_testdata_async(TestData) ->
+ cast({set_testdata, TestData}).
+
get_testdata(Key) ->
call({get_testdata, Key}).
@@ -317,7 +319,7 @@ loop(Mode,TestData,StartDir) ->
{reset_cwd,From} ->
return(From,file:set_cwd(StartDir)),
loop(From,TestData,StartDir);
- {{stop,How},From} ->
+ {{stop,Info},From} ->
Time = calendar:local_time(),
ct_event:sync_notify(#event{name=test_done,
node=node(),
@@ -330,11 +332,11 @@ loop(Mode,TestData,StartDir) ->
ets:delete(?conn_table),
ets:delete(?board_table),
ets:delete(?suite_table),
- ct_logs:close(How),
+ ct_logs:close(Info),
ct_event:stop(),
ct_config:stop(),
file:set_cwd(StartDir),
- return(From,ok);
+ return(From, Info);
{Ref, _Msg} when is_reference(Ref) ->
%% This clause is used when doing cast operations.
loop(Mode,TestData,StartDir);
@@ -537,16 +539,16 @@ reset_silent_connections() ->
%%%-----------------------------------------------------------------
-%%% @spec stop(How) -> ok
+%%% @spec stop(Info) -> ok
%%%
%%% @doc Stop the ct_util_server and close all existing connections
%%% (tool-internal use only).
%%%
%%% @see ct
-stop(How) ->
+stop(Info) ->
case whereis(ct_util_server) of
undefined -> ok;
- _ -> call({stop,How})
+ _ -> call({stop,Info})
end.
%%%-----------------------------------------------------------------
diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl
index 2ee982d726..081f98e889 100644
--- a/lib/common_test/src/vts.erl
+++ b/lib/common_test/src/vts.erl
@@ -281,9 +281,7 @@ run_test1(State=#state{tests=Tests,current_log_dir=LogDir}) ->
end,
unlink(Self)
end,
-
Pid = spawn_link(RunTest),
-
Total =
receive
{{test_info,start_info,{_,_,Cases}},From} ->
@@ -480,7 +478,7 @@ create_testdir_entries([],_N) ->
[].
testdir_entry(Dir,Suite,Case,N) ->
- NStr = integer_to_list(N),
+ NStr = vts_integer_to_list(N),
tr([td(delete_button(NStr)),
td(Dir),
td(suite_select(Dir,Suite,NStr)),
@@ -691,11 +689,11 @@ result_summary_frame1(State) ->
result_summary_body(State) ->
N = State#state.ok + State#state.fail + State#state.skip,
[h2("Result Summary"),
- p([b(integer_to_list(N))," cases executed (of ",
- b(integer_to_list(State#state.total)),")"]),
- p([green([b(integer_to_list(State#state.ok))," successful"]),br(),
- red([b(integer_to_list(State#state.fail))," failed"]),br(),
- orange([b(integer_to_list(State#state.skip))," skipped"])]),
+ p([b(vts_integer_to_list(N))," cases executed (of ",
+ b(vts_integer_to_list(State#state.total)),")"]),
+ p([green([b(vts_integer_to_list(State#state.ok))," successful"]),br(),
+ red([b(vts_integer_to_list(State#state.fail))," failed"]),br(),
+ orange([b(vts_integer_to_list(State#state.skip))," skipped"])]),
executed_test_list(State)].
executed_test_list(#state{testruns=[]}) ->
@@ -735,6 +733,14 @@ report1(tc_done,{_Suite,init_per_suite,_},State) ->
State;
report1(tc_done,{_Suite,end_per_suite,_},State) ->
State;
+report1(tc_done,{_Suite,init_per_group,_},State) ->
+ State;
+report1(tc_done,{_Suite,end_per_group,_},State) ->
+ State;
+report1(tc_done,{_Suite,ct_init_per_group,_},State) ->
+ State;
+report1(tc_done,{_Suite,ct_end_per_group,_},State) ->
+ State;
report1(tc_done,{_Suite,_Case,ok},State) ->
State#state{ok=State#state.ok+1};
report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) ->
@@ -742,7 +748,9 @@ report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) ->
report1(tc_done,{_Suite,_Case,{skipped,_Reason}},State) ->
State#state{skip=State#state.skip+1};
report1(tc_user_skip,{_Suite,_Case,_Reason},State) ->
- State#state{skip=State#state.skip+1}.
+ State#state{skip=State#state.skip+1};
+report1(loginfo,_,State) ->
+ State.
get_test_log(TestName,LogDir) ->
[Log] =
@@ -882,3 +890,7 @@ get_input_data(Input,Key)->
parse(Input) ->
httpd:parse_query(Input).
+vts_integer_to_list(X) when is_atom(X) ->
+ atom_to_list(X);
+vts_integer_to_list(X) when is_integer(X) ->
+ integer_to_list(X).
diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl
index b6b50f33e0..8ce75f582a 100644
--- a/lib/common_test/test/ct_config_SUITE.erl
+++ b/lib/common_test/test/ct_config_SUITE.erl
@@ -174,7 +174,8 @@ run_test(Name, Config, CTConfig, SuiteNames)->
TestEvents = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(Name,
reformat_events(TestEvents, ?eh),
- ?config(config_dir, Config)),
+ ?config(config_dir, Config),
+ Opts),
ExpEvents = events_to_check(Name),
ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config).
diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl
index ad6cf1ba8f..6867e59b60 100644
--- a/lib/common_test/test/ct_error_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE.erl
@@ -102,8 +102,9 @@ cfg_error(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(cfg_error,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(cfg_error),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -120,8 +121,9 @@ lib_error(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(lib_error,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(lib_error),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -138,8 +140,9 @@ no_compile(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(no_compile,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(no_compile),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -156,7 +159,8 @@ timetrap_end_conf(Config) when is_list(Config) ->
ct_test_support:log_events(timetrap_end_conf,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(timetrap_end_conf),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -176,7 +180,8 @@ timetrap_normal(Config) when is_list(Config) ->
ct_test_support:log_events(timetrap_normal,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(timetrap_normal),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -198,12 +203,31 @@ timetrap_extended(Config) when is_list(Config) ->
ct_test_support:log_events(timetrap_extended,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(timetrap_extended),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
%%%-----------------------------------------------------------------
+%%%
+timetrap_parallel(Config) when is_list(Config) ->
+ DataDir = ?config(data_dir, Config),
+ Join = fun(D, S) -> filename:join(D, "error/test/"++S) end,
+ Suite = Join(DataDir, "timetrap_3_SUITE"),
+ {Opts,ERPid} = setup([{suite,Suite}], Config),
+ ok = ct_test_support:run(Opts, Config),
+ Events = ct_test_support:get_events(ERPid, Config),
+
+ ct_test_support:log_events(timetrap_parallel,
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+
+ TestEvents = events_to_check(timetrap_parallel),
+ ok = ct_test_support:verify_events(TestEvents, Events, Config).
+
+%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
@@ -236,7 +260,7 @@ test_events(cfg_error) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
- {?eh,start_info,{14,14,42}},
+ {?eh,start_info,{14,14,43}},
{?eh,tc_start,{cfg_error_1_SUITE,init_per_suite}},
{?eh,tc_done,
@@ -405,7 +429,6 @@ test_events(cfg_error) ->
{cfg_error_8_SUITE,{init_per_group,g3,[]},
{failed,{error,{{badmatch,42},
[{cfg_error_8_SUITE,init_per_group,2},
- {cfg_error_8_SUITE,init_per_group,2},
{test_server,my_apply,3},
{test_server,ts_tc,3},
{test_server,run_test_case_eval1,6},
@@ -415,7 +438,6 @@ test_events(cfg_error) ->
{failed,{cfg_error_8_SUITE,init_per_group,
{'EXIT',{{badmatch,42},
[{cfg_error_8_SUITE,init_per_group,2},
- {cfg_error_8_SUITE,init_per_group,2},
{test_server,my_apply,3},
{test_server,ts_tc,3},
{test_server,run_test_case_eval1,6},
@@ -426,7 +448,6 @@ test_events(cfg_error) ->
{failed,{cfg_error_8_SUITE,init_per_group,
{'EXIT',{{badmatch,42},
[{cfg_error_8_SUITE,init_per_group,2},
- {cfg_error_8_SUITE,init_per_group,2},
{test_server,my_apply,3},
{test_server,ts_tc,3},
{test_server,run_test_case_eval1,6},
@@ -520,16 +541,19 @@ test_events(cfg_error) ->
%%! end_tc failes the testcase
{?eh,tc_done,{cfg_error_9_SUITE,tc6,ok}},
{?eh,test_stats,{9,2,{0,18}}},
+ {?eh,tc_start,{cfg_error_9_SUITE,tc7}},
+ {?eh,tc_done,{cfg_error_9_SUITE,tc7,{failed,{error,tc7_should_be_failed}}}},
+ {ct_test_support_eh,test_stats,{9,3,{0,18}}},
{?eh,tc_start,{cfg_error_9_SUITE,tc11}},
{?eh,tc_done,{cfg_error_9_SUITE,tc11,
{failed,{cfg_error_9_SUITE,end_per_testcase,
{'EXIT',warning_should_be_printed}}}}},
- {?eh,test_stats,{10,2,{0,18}}},
+ {?eh,test_stats,{10,3,{0,18}}},
{?eh,tc_start,{cfg_error_9_SUITE,tc12}},
{?eh,tc_done,{cfg_error_9_SUITE,tc12,
{failed,{cfg_error_9_SUITE,end_per_testcase,
{timetrap_timeout,2000}}}}},
- {?eh,test_stats,{11,2,{0,18}}},
+ {?eh,test_stats,{11,3,{0,18}}},
{?eh,tc_start,{cfg_error_9_SUITE,tc13}},
{?eh,tc_done,{cfg_error_9_SUITE,tc13,
{failed,{cfg_error_9_SUITE,end_per_testcase,
@@ -539,11 +563,11 @@ test_events(cfg_error) ->
{test_server,do_end_per_testcase,4},
{test_server,run_test_case_eval1,6},
{test_server,run_test_case_eval,8}]}}}}}},
- {?eh,test_stats,{12,2,{0,18}}},
+ {?eh,test_stats,{12,3,{0,18}}},
{?eh,tc_start,{cfg_error_9_SUITE,tc14}},
{?eh,tc_done,
{cfg_error_9_SUITE,tc14,{failed,{error,tc14_should_be_failed}}}},
- {?eh,test_stats,{12,3,{0,18}}},
+ {?eh,test_stats,{12,4,{0,18}}},
{?eh,tc_start,{cfg_error_9_SUITE,end_per_suite}},
{?eh,tc_done,{cfg_error_9_SUITE,end_per_suite,ok}},
@@ -554,7 +578,7 @@ test_events(cfg_error) ->
{?eh,tc_auto_skip,{cfg_error_10_SUITE,tc1,
{failed,{cfg_error_10_SUITE,init_per_suite,
{failed,fail_init_per_suite}}}}},
- {?eh,test_stats,{12,3,{0,19}}},
+ {?eh,test_stats,{12,4,{0,19}}},
{?eh,tc_auto_skip,{cfg_error_10_SUITE,end_per_suite,
{failed,{cfg_error_10_SUITE,init_per_suite,
{failed,fail_init_per_suite}}}}},
@@ -563,40 +587,40 @@ test_events(cfg_error) ->
{?eh,tc_start,{cfg_error_11_SUITE,tc1}},
{?eh,tc_done,{cfg_error_11_SUITE,tc1,
{skipped,{config_name_already_in_use,[dummy0]}}}},
- {?eh,test_stats,{12,3,{1,19}}},
+ {?eh,test_stats,{12,4,{1,19}}},
{?eh,tc_start,{cfg_error_11_SUITE,tc2}},
{?eh,tc_done,{cfg_error_11_SUITE,tc2,ok}},
- {?eh,test_stats,{13,3,{1,19}}},
+ {?eh,test_stats,{13,4,{1,19}}},
{?eh,tc_start,{cfg_error_11_SUITE,end_per_suite}},
{?eh,tc_done,{cfg_error_11_SUITE,end_per_suite,ok}},
{?eh,tc_start,{cfg_error_12_SUITE,tc1}},
{?eh,tc_done,{cfg_error_12_SUITE,tc1,{failed,{timetrap_timeout,500}}}},
- {?eh,test_stats,{13,4,{1,19}}},
+ {?eh,test_stats,{13,5,{1,19}}},
{?eh,tc_start,{cfg_error_12_SUITE,tc2}},
{?eh,tc_done,{cfg_error_12_SUITE,tc2,{failed,
{cfg_error_12_SUITE,end_per_testcase,
{timetrap_timeout,500}}}}},
- {?eh,test_stats,{14,4,{1,19}}},
+ {?eh,test_stats,{14,5,{1,19}}},
{?eh,tc_start,{cfg_error_12_SUITE,tc3}},
{?eh,tc_done,{cfg_error_12_SUITE,tc3,ok}},
- {?eh,test_stats,{15,4,{1,19}}},
+ {?eh,test_stats,{15,5,{1,19}}},
{?eh,tc_start,{cfg_error_12_SUITE,tc4}},
{?eh,tc_done,{cfg_error_12_SUITE,tc4,{failed,
{cfg_error_12_SUITE,end_per_testcase,
{timetrap_timeout,500}}}}},
- {?eh,test_stats,{16,4,{1,19}}},
+ {?eh,test_stats,{16,5,{1,19}}},
{?eh,tc_start,{cfg_error_13_SUITE,init_per_suite}},
{?eh,tc_done,{cfg_error_13_SUITE,init_per_suite,ok}},
{?eh,tc_start,{cfg_error_13_SUITE,tc1}},
{?eh,tc_done,{cfg_error_13_SUITE,tc1,ok}},
- {?eh,test_stats,{17,4,{1,19}}},
+ {?eh,test_stats,{17,5,{1,19}}},
{?eh,tc_start,{cfg_error_13_SUITE,end_per_suite}},
{?eh,tc_done,{cfg_error_13_SUITE,end_per_suite,ok}},
{?eh,tc_start,{cfg_error_14_SUITE,init_per_suite}},
{?eh,tc_done,{cfg_error_14_SUITE,init_per_suite,ok}},
{?eh,tc_start,{cfg_error_14_SUITE,tc1}},
{?eh,tc_done,{cfg_error_14_SUITE,tc1,ok}},
- {?eh,test_stats,{18,4,{1,19}}},
+ {?eh,test_stats,{18,5,{1,19}}},
{?eh,tc_start,{cfg_error_14_SUITE,end_per_suite}},
{?eh,tc_done,{cfg_error_14_SUITE,end_per_suite,
{comment,
@@ -729,7 +753,7 @@ test_events(timetrap_normal) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
- {?eh,start_info,{1,1,3}},
+ {?eh,start_info,{1,1,4}},
{?eh,tc_start,{timetrap_2_SUITE,init_per_suite}},
{?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}},
{?eh,tc_start,{timetrap_2_SUITE,tc0}},
@@ -744,6 +768,9 @@ test_events(timetrap_normal) ->
{?eh,tc_done,
{timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,500}}}},
{?eh,test_stats,{0,3,{0,0}}},
+ {?eh,tc_start,{timetrap_2_SUITE,tc3}},
+ {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}},
+ {?eh,test_stats,{1,3,{0,0}}},
{?eh,tc_start,{timetrap_2_SUITE,end_per_suite}},
{?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
@@ -754,7 +781,7 @@ test_events(timetrap_extended) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
- {?eh,start_info,{1,1,3}},
+ {?eh,start_info,{1,1,4}},
{?eh,tc_start,{timetrap_2_SUITE,init_per_suite}},
{?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}},
{?eh,tc_start,{timetrap_2_SUITE,tc0}},
@@ -769,8 +796,52 @@ test_events(timetrap_extended) ->
{?eh,tc_done,
{timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,1000}}}},
{?eh,test_stats,{0,3,{0,0}}},
+ {?eh,tc_start,{timetrap_2_SUITE,tc3}},
+ {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}},
+ {?eh,test_stats,{1,3,{0,0}}},
{?eh,tc_start,{timetrap_2_SUITE,end_per_suite}},
{?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
- ].
+ ];
+
+test_events(timetrap_parallel) ->
+ [
+ {?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,7}},
+ {?eh,tc_done,{timetrap_3_SUITE,init_per_suite,ok}},
+ {parallel,
+ [{?eh,tc_start,
+ {timetrap_3_SUITE,{init_per_group,g1,[parallel]}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,{init_per_group,g1,[parallel]},ok}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc0}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc1}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc2}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc3}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc4}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc6}},
+ {?eh,tc_start,{timetrap_3_SUITE,tc7}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc1,{failed,{timetrap_timeout,500}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc2,{failed,{timetrap_timeout,1000}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc6,{failed,{timetrap_timeout,1000}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc7,{failed,{timetrap_timeout,1500}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc0,{failed,{timetrap_timeout,2000}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc4,{failed,{timetrap_timeout,2000}}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,tc3,{failed,{timetrap_timeout,3000}}}},
+ {?eh,test_stats,{0,7,{0,0}}},
+ {?eh,tc_start,
+ {timetrap_3_SUITE,{end_per_group,g1,[parallel]}}},
+ {?eh,tc_done,
+ {timetrap_3_SUITE,{end_per_group,g1,[parallel]},ok}}]},
+ {?eh,tc_done,{timetrap_3_SUITE,end_per_suite,ok}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}].
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl
index d73287ad62..40b7d2da47 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl
@@ -83,6 +83,8 @@ init_per_testcase(tc3, Config) ->
Config;
init_per_testcase(tc4, _) ->
ok;
+init_per_testcase(tc7, _) ->
+ {fail,tc7_should_be_failed};
init_per_testcase(_, Config) ->
Config.
@@ -136,7 +138,7 @@ groups() ->
%% Reason = term()
%%--------------------------------------------------------------------
all() ->
- [tc1,tc2,tc3,tc4,tc5,tc6,
+ [tc1,tc2,tc3,tc4,tc5,tc6,tc7,
tc11,tc12,tc13,tc14].
tc1(_) ->
@@ -171,6 +173,11 @@ tc6(_) ->
ct:comment("This one should succeed but then get failed by end_tc!"),
fini.
+tc7(_) ->
+ ct:comment("This one should get failed by iptc!"),
+ fini.
+
+
tc11(_) ->
fini.
tc12(_) ->
diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl
index 99bb400137..7fcb631d06 100644
--- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl
+++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl
@@ -77,8 +77,8 @@ init_per_testcase(tc1, Config) ->
ct:timetrap({seconds,1}),
Config;
-init_per_testcase(tc3, Config) ->
- ct:timetrap({seconds,1}),
+init_per_testcase(tc2, Config) ->
+ ct:timetrap(250),
Config;
init_per_testcase(_TestCase, Config) ->
@@ -90,7 +90,7 @@ init_per_testcase(_TestCase, Config) ->
%% TestCase = atom()
%% Config0 = Config1 = [tuple()]
%%--------------------------------------------------------------------
-end_per_testcase(_, Config) ->
+end_per_testcase(_, _Config) ->
ok.
%%--------------------------------------------------------------------
@@ -116,7 +116,7 @@ groups() ->
%% Reason = term()
%%--------------------------------------------------------------------
all() ->
- [tc0,tc1,tc2].
+ [tc0,tc1,tc2,tc3].
tc0(_) ->
N = list_to_integer(ct:get_config(multiply)),
@@ -131,8 +131,24 @@ tc1(_) ->
ok.
tc2(_) ->
+ ct:timetrap(500),
N = list_to_integer(ct:get_config(multiply)),
ct:comment(io_lib:format("TO after ~w sec", [0.5*N])),
- ct:timetrap(500),
ct:sleep(2000),
ok.
+
+tc3() ->
+ [{timetrap,{seconds,2}}].
+
+tc3(_) ->
+ T0 = now(),
+ ct:timetrap(infinity),
+ N = list_to_integer(ct:get_config(multiply)),
+ ct:comment(io_lib:format("Sleeping for ~w sec...", [4*N])),
+ ct:sleep(4000),
+ Diff = timer:now_diff(now(), T0),
+ if ((Diff < (N*4000000)) or (Diff > (N*4500000))) ->
+ exit(not_expected);
+ true ->
+ ok
+ end.
diff --git a/lib/common_test/test/ct_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl
index 5ef04c0e75..b534a7141d 100644
--- a/lib/common_test/test/ct_event_handler_SUITE.erl
+++ b/lib/common_test/test/ct_event_handler_SUITE.erl
@@ -102,8 +102,9 @@ start_stop(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(start_stop,
- ct_test_support:reformat(Events, eh_A),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, eh_A),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents =
[{eh_A,start_logging,{'DEF','RUNDIR'}},
@@ -148,8 +149,9 @@ results(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(results,
- ct_test_support:reformat(Events, eh_A),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, eh_A),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents =
[{eh_A,start_logging,{'DEF','RUNDIR'}},
diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl
index 7775d8a55d..e520a72227 100644
--- a/lib/common_test/test/ct_groups_test_1_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl
@@ -89,8 +89,9 @@ groups_suite_1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_suite_1,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(groups_suite_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -109,8 +110,9 @@ groups_suite_2(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_suite_2,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(groups_suite_2),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -130,8 +132,9 @@ groups_suites_1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_suites_1,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(groups_suites_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -150,8 +153,9 @@ groups_dir_1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_dir_1,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(groups_dir_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -170,8 +174,9 @@ groups_dirs_1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_dirs_1,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(groups_dirs_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl
index 2ae63f4f99..f33be8a9d4 100644
--- a/lib/common_test/test/ct_groups_test_2_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl
@@ -59,7 +59,7 @@ end_per_testcase(TestCase, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [missing_conf, repeat_1].
+ [missing_conf, repeat_1, empty_group].
groups() ->
[].
@@ -83,13 +83,14 @@ missing_conf(Config) when is_list(Config) ->
Suite = filename:join(DataDir, "groups_1/missing_conf_SUITE"),
- {Opts,ERPid} = setup({suite,Suite}, Config),
+ {Opts,ERPid} = setup([{suite,Suite}], Config),
ok = ct_test_support:run(Opts, Config),
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(missing_conf_SUITE,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(missing_conf),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -102,18 +103,41 @@ repeat_1(Config) when is_list(Config) ->
Suite = filename:join(DataDir, "groups_1/repeat_1_SUITE"),
- {Opts,ERPid} = setup({suite,Suite}, Config),
+ {Opts,ERPid} = setup([{suite,Suite}], Config),
ok = ct_test_support:run(Opts, Config),
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(repeat_1,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(repeat_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
%%%-----------------------------------------------------------------
+%%%
+
+empty_group(Config) when is_list(Config) ->
+ DataDir = ?config(data_dir, Config),
+
+ Suite = filename:join(DataDir, "groups_2/groups_22_SUITE"),
+
+ {Opts,ERPid} = setup([{suite,Suite},
+ {group,[test_group_8,test_group_9,test_group_10]}],
+ Config),
+ ok = ct_test_support:run(Opts, Config),
+ Events = ct_test_support:get_events(ERPid, Config),
+
+ ct_test_support:log_events(empty_group,
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
+
+ TestEvents = events_to_check(empty_group),
+ ok = ct_test_support:verify_events(TestEvents, Events, Config).
+
+%%%-----------------------------------------------------------------
%%% HELP FUNCTIONS
%%%-----------------------------------------------------------------
@@ -121,7 +145,7 @@ setup(Test, Config) ->
Opts0 = ct_test_support:get_opts(Config),
Level = ?config(trace_level, Config),
EvHArgs = [{cbm,ct_test_support},{trace_level,Level}],
- Opts = Opts0 ++ [Test,{event_handler,{?eh,EvHArgs}}],
+ Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test],
ERPid = ct_test_support:start_event_receiver(Config),
{Opts,ERPid}.
@@ -256,4 +280,27 @@ test_events(repeat_1) ->
{?eh,tc_done,{repeat_1_SUITE,end_per_suite,ok}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}
+ ];
+
+test_events(empty_group) ->
+ [{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,start_info,{1,1,1}},
+ {?eh,tc_start,{groups_22_SUITE,init_per_suite}},
+ {?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}},
+ [{?eh,tc_start,
+ {groups_22_SUITE,{init_per_group,test_group_8,[]}}},
+ {?eh,tc_done,
+ {groups_22_SUITE,{init_per_group,test_group_8,[]},ok}},
+ {?eh,tc_start,{groups_22_SUITE,testcase_8}},
+ {?eh,tc_done,{groups_22_SUITE,testcase_8,ok}},
+ {?eh,test_stats,{1,0,{0,0}}},
+ {?eh,tc_start,
+ {groups_22_SUITE,{end_per_group,test_group_8,[]}}},
+ {?eh,tc_done,
+ {groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}],
+ {?eh,tc_start,{groups_22_SUITE,end_per_suite}},
+ {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}},
+ {?eh,test_done,{'DEF','STOP_TIME'}},
+ {?eh,stop_logging,[]}
].
diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
index cd517876df..14eb8769ad 100644
--- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
+++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl
@@ -31,27 +31,33 @@ suite() ->
groups() ->
[
- {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]},
+ {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]},
- {test_group_1b, [parallel], [testcase_1a,testcase_1b]},
+ {test_group_1b, [parallel], [testcase_1a,testcase_1b]},
- {test_group_2, [parallel], [testcase_2a,
+ {test_group_2, [parallel], [testcase_2a,
- {test_group_3, [{repeat,1}],
- [testcase_3a, testcase_3b]},
+ {test_group_3, [{repeat,1}],
+ [testcase_3a, testcase_3b]},
- testcase_2b]},
+ testcase_2b]},
- {test_group_4, [{test_group_5, [parallel], [testcase_5a,
+ {test_group_4, [{test_group_5, [parallel], [testcase_5a,
- {group, test_group_6},
+ {group, test_group_6},
- testcase_5b]}]},
+ testcase_5b]}]},
- {test_group_6, [parallel], [{group, test_group_7}]},
+ {test_group_6, [parallel], [{group, test_group_7}]},
- {test_group_7, [sequence], [testcase_7a,testcase_7b]}
- ].
+ {test_group_7, [sequence], [testcase_7a,testcase_7b]},
+
+ {test_group_8, [], [{group, test_group_9}, testcase_8]},
+
+ {test_group_9, [], []},
+
+ {test_group_10, [], [{group, test_group_9}]}
+ ].
all() ->
[{group, test_group_1a},
@@ -60,7 +66,10 @@ all() ->
testcase_2,
{group, test_group_2},
testcase_3,
- {group, test_group_4}].
+ {group, test_group_4},
+ {group, test_group_8},
+ {group, test_group_9},
+ {group, test_group_10}].
%% this func only for internal test purposes
grs_and_tcs() ->
@@ -68,7 +77,9 @@ grs_and_tcs() ->
test_group_1a, test_group_1b,
test_group_2, test_group_3,
test_group_4, test_group_5,
- test_group_6, test_group_7
+ test_group_6, test_group_7,
+ test_group_8, test_group_9,
+ test_group_10
],
[
testcase_1a, testcase_1b, testcase_1c,
@@ -78,7 +89,8 @@ grs_and_tcs() ->
testcase_3a, testcase_3b,
testcase_3,
testcase_5a, testcase_5b,
- testcase_7a, testcase_7b
+ testcase_7a, testcase_7b,
+ testcase_8
]}.
%%--------------------------------------------------------------------
@@ -107,7 +119,10 @@ init_per_group(Group, Config) ->
{test_group_4,[{name,test_group_4}]} -> ok;
{test_group_5,[{name,test_group_5},parallel]} -> "parallel";
{test_group_6,[{name,test_group_6},parallel]} -> "parallel";
- {test_group_7,[{name,test_group_7},sequence]} -> "sequence"
+ {test_group_7,[{name,test_group_7},sequence]} -> "sequence";
+ {test_group_8,[{name,test_group_8}]} -> ok;
+ {test_group_9,[{name,test_group_9}]} -> ok;
+ {test_group_10,[{name,test_group_10}]} -> ok
end,
{Grs,_} = grs_and_tcs(),
case lists:member(Group, Grs) of
@@ -312,3 +327,7 @@ testcase_7b(Config) ->
undefined = ?config(testcase_7a,Config),
testcase_7b = ?config(testcase_7b,Config),
ok.
+testcase_8() ->
+ [].
+testcase_8(_Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl
index 64f4e277ff..be1c02f163 100644
--- a/lib/common_test/test/ct_hooks_SUITE.erl
+++ b/lib/common_test/test/ct_hooks_SUITE.erl
@@ -225,8 +225,9 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(Tag,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(Tag, EC),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -259,9 +260,9 @@ events_to_check(Test, N) ->
test_events(one_empty_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{empty_cth,id,[[]]}},
{?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{empty_cth,pre_init_per_suite,
[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -287,11 +288,11 @@ test_events(one_empty_cth) ->
test_events(two_empty_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -329,8 +330,8 @@ test_events(faulty_cth_no_init) ->
test_events(faulty_cth_id_no_init) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',id,[[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',id,[[]]}},
{negative,{?eh,tc_start,'_'},
{?eh,test_done,{'DEF','STOP_TIME'}}},
{?eh,stop_logging,[]}
@@ -339,9 +340,9 @@ test_events(faulty_cth_id_no_init) ->
test_events(minimal_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{negative,{?eh,cth,{'_',id,['_',[]]}},
{?eh,cth,{'_',init,['_',[]]}}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}},
@@ -357,11 +358,11 @@ test_events(minimal_cth) ->
test_events(minimal_and_maximal_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{negative,{?eh,cth,{'_',id,['_',[]]}},
{?eh,cth,{'_',init,['_',[]]}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,['_',[]]}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
@@ -387,8 +388,8 @@ test_events(faulty_cth_undef) ->
{failed,FailReasonStr}},
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,
{failed, {error,FailReasonStr}}}},
@@ -433,15 +434,15 @@ test_events(faulty_cth_exit_in_init_scope_suite) ->
test_events(faulty_cth_exit_in_init) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{empty_cth,init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,['_',[]]}},
{?eh,test_done,{'DEF','STOP_TIME'}},
{?eh,stop_logging,[]}];
test_events(faulty_cth_exit_in_id) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{empty_cth,id,[[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,id,[[]]}},
{negative, {?eh,tc_start,'_'},
{?eh,test_done,{'DEF','STOP_TIME'}}},
{?eh,stop_logging,[]}];
@@ -609,9 +610,8 @@ test_events(scope_per_group_state_cth) ->
test_events(fail_pre_suite_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
-
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -649,8 +649,8 @@ test_events(fail_pre_suite_cth) ->
test_events(fail_post_suite_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}},
@@ -676,8 +676,8 @@ test_events(fail_post_suite_cth) ->
test_events(skip_pre_suite_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}},
@@ -699,8 +699,8 @@ test_events(skip_pre_suite_cth) ->
test_events(skip_post_suite_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
@@ -724,8 +724,8 @@ test_events(recover_post_suite_cth) ->
Suite = ct_cth_fail_per_suite_SUITE,
[
{?eh,start_logging,'_'},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{Suite,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[Suite,'$proplist','$proplist']}},
{?eh,cth,{'_',post_init_per_suite,[Suite,contains([tc_status]),
@@ -753,8 +753,8 @@ test_events(recover_post_suite_cth) ->
test_events(update_config_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{ct_update_config_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,
@@ -864,9 +864,9 @@ test_events(update_config_cth) ->
test_events(state_update_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',init,['_',[]]}},
{?eh,cth,{'_',init,['_',[]]}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{'_',init_per_suite}},
{?eh,tc_done,{'_',end_per_suite,ok}},
@@ -902,8 +902,8 @@ test_events(state_update_cth) ->
test_events(options_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{empty_cth,init,['_',[test]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{empty_cth,init,['_',[test]]}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{empty_cth,pre_init_per_suite,
[ct_cth_empty_SUITE,'$proplist',[test]]}},
@@ -929,10 +929,10 @@ test_events(options_cth) ->
test_events(same_id_cth) ->
[
{?eh,start_logging,{'DEF','RUNDIR'}},
+ {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,cth,{'_',id,[[]]}},
{?eh,cth,{'_',init,[same_id_cth,[]]}},
{?eh,cth,{'_',id,[[]]}},
- {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
{?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}},
{?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}},
{negative,
@@ -969,8 +969,8 @@ test_events(same_id_cth) ->
test_events(fail_n_skip_with_minimal_cth) ->
[{?eh,start_logging,{'DEF','RUNDIR'}},
- {?eh,cth,{'_',init,['_',[]]}},
{?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}},
+ {?eh,cth,{'_',init,['_',[]]}},
{?eh,tc_start,{'_',init_per_suite}},
{?eh,tc_done,{'_',end_per_suite,ok}},
diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl
index e89b6f7de6..1471cc1e0c 100644
--- a/lib/common_test/test/ct_master_SUITE.erl
+++ b/lib/common_test/test/ct_master_SUITE.erl
@@ -119,8 +119,9 @@ ct_master_test(Config) when is_list(Config)->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(groups_suite_1,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ PrivDir, []),
+
find_events(NodeNames, [{tc_start,{master_SUITE,init_per_suite}},
{tc_start,{master_SUITE,first_testcase}},
{tc_start,{master_SUITE,second_testcase}},
@@ -174,7 +175,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config)->
ct_test_support:write_testspec(N++Include++EH++C++S++LD++NS, FileName).
-get_log_dir({win32,_},PrivDir, NodeName)->
+get_log_dir({win32,_}, _PrivDir, NodeName)->
case filelib:is_dir(?TEMP_DIR) of
false ->
file:make_dir(?TEMP_DIR);
diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl
index a8bd2c2189..cb17af9ab5 100644
--- a/lib/common_test/test/ct_misc_1_SUITE.erl
+++ b/lib/common_test/test/ct_misc_1_SUITE.erl
@@ -111,7 +111,8 @@ beam_me_up(Config) when is_list(Config) ->
ct_test_support:log_events(beam_me_up,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(beam_me_up, 1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl
index e674315526..4e842bd6d6 100644
--- a/lib/common_test/test/ct_repeat_1_SUITE.erl
+++ b/lib/common_test/test/ct_repeat_1_SUITE.erl
@@ -159,7 +159,8 @@ execute(TestCase, SuiteName, Group, Config) ->
ct_test_support:log_events(TestCase,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(TestCase),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -561,7 +562,6 @@ test_events(repeat_cs_until_any_fail) ->
{error,
{{badmatch,2},
[{repeat_1_SUITE,tc_fail_1,1},
- {repeat_1_SUITE,tc_fail_1,1},
{test_server,my_apply,3},
{test_server,ts_tc,3},
{test_server,run_test_case_eval1,6},
diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl
index c7650b169c..5facf90656 100644
--- a/lib/common_test/test/ct_sequence_1_SUITE.erl
+++ b/lib/common_test/test/ct_sequence_1_SUITE.erl
@@ -132,7 +132,8 @@ execute(TestCase, SuiteName, Group, Config) ->
ct_test_support:log_events(TestCase,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(TestCase),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl
index 62c5f10b7c..4ba4479208 100644
--- a/lib/common_test/test/ct_skip_SUITE.erl
+++ b/lib/common_test/test/ct_skip_SUITE.erl
@@ -99,8 +99,9 @@ auto_skip(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(auto_skip,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(auto_skip),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -122,8 +123,9 @@ user_skip(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(user_skip,
- reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(user_skip),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl
index c3d49a5afa..49b38361e2 100644
--- a/lib/common_test/test/ct_smoke_test_SUITE.erl
+++ b/lib/common_test/test/ct_smoke_test_SUITE.erl
@@ -175,8 +175,9 @@ dir1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(dir1,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(dir1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -204,8 +205,9 @@ dir2(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(dir2,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(dir2),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -234,8 +236,9 @@ dir1_2(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(dir1_2,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(dir1_2),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -264,8 +267,8 @@ suite11(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(suite11,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(suite11),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -293,8 +296,8 @@ suite21(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(suite21,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(suite21),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -324,8 +327,8 @@ suite11_21(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(suite11_21,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(suite11_21),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -355,8 +358,8 @@ tc111(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(tc111,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(tc111),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -385,8 +388,8 @@ tc211(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(tc211,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(tc211),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -416,8 +419,8 @@ tc111_112(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(tc111_112,
- ct_test_support:reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ct_test_support:reformat(Events, ?eh),
+ ?config(priv_dir, Config), Opts),
TestEvents = events_to_check(tc111_112),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
index 9d3e6a9e59..4471915e69 100644
--- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl
+++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl
@@ -98,8 +98,9 @@ ts_if_1(Config) when is_list(Config) ->
Events = ct_test_support:get_events(ERPid, Config),
ct_test_support:log_events(ts_if_1,
- reformat(Events, ?eh),
- PrivDir),
+ reformat(Events, ?eh),
+ PrivDir,
+ Opts),
TestEvents = events_to_check(ts_if_1),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl
index b4f1a0e71f..601d5315ce 100644
--- a/lib/common_test/test/ct_test_support.erl
+++ b/lib/common_test/test/ct_test_support.erl
@@ -32,7 +32,8 @@
run/2, run/4, get_opts/1, wait_for_ct_stop/1]).
-export([handle_event/2, start_event_receiver/1, get_events/2,
- verify_events/3, reformat/2, log_events/3]).
+ verify_events/3, reformat/2, log_events/4,
+ join_abs_dirs/2]).
-include_lib("kernel/include/file.hrl").
@@ -63,7 +64,6 @@ init_per_suite(Config, Level) ->
start_slave(Config,Level) ->
[_,Host] = string:tokens(atom_to_list(node()), "@"),
-
test_server:format(0, "Trying to start ~s~n", ["ct@"++Host]),
case slave:start(Host, ct, []) of
{error,Reason} ->
@@ -72,18 +72,19 @@ start_slave(Config,Level) ->
test_server:format(0, "Node ~p started~n", [CTNode]),
IsCover = test_server:is_cover(),
if IsCover ->
- cover:start(CTNode);
- true->
- ok
+ cover:start(CTNode);
+ true->
+ ok
end,
- DataDir = ?config(data_dir, Config),
- PrivDir = ?config(priv_dir, Config),
+
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
%% PrivDir as well as directory of Test Server suites
%% have to be in code path on Common Test node.
[_ | Parts] = lists:reverse(filename:split(DataDir)),
TSDir = filename:join(lists:reverse(Parts)),
- AddPathDirs = case ?config(path_dirs, Config) of
+ AddPathDirs = case proplists:get_value(path_dirs, Config) of
undefined -> [];
Ds -> Ds
end,
@@ -110,8 +111,8 @@ start_slave(Config,Level) ->
%%% end_per_suite/1
end_per_suite(Config) ->
- CTNode = ?config(ct_node, Config),
- PrivDir = ?config(priv_dir, Config),
+ CTNode = proplists:get_value(ct_node, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
true = rpc:call(CTNode, code, del_path, [filename:join(PrivDir,"")]),
cover:stop(CTNode),
slave:stop(CTNode),
@@ -121,7 +122,9 @@ end_per_suite(Config) ->
%%% init_per_testcase/2
init_per_testcase(_TestCase, Config) ->
- {_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)),
+ Opts = get_opts(Config),
+ NetDir = proplists:get_value(net_dir, Opts),
+ LogDir = join_abs_dirs(NetDir, proplists:get_value(logdir, Opts)),
case lists:keysearch(master, 1, Config) of
false->
test_server:format("See Common Test logs here:\n\n"
@@ -139,7 +142,7 @@ init_per_testcase(_TestCase, Config) ->
%%% end_per_testcase/2
end_per_testcase(_TestCase, Config) ->
- CTNode = ?config(ct_node, Config),
+ CTNode = proplists:get_value(ct_node, Config),
case wait_for_ct_stop(CTNode) of
%% Common test was not stopped to we restart node.
false ->
@@ -169,7 +172,7 @@ write_testspec(TestSpec, TSFile) ->
%%%
get_opts(Config) ->
- PrivDir = ?config(priv_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
TempDir = case os:getenv("TMP") of
false ->
case os:getenv("TEMP") of
@@ -195,20 +198,48 @@ get_opts(Config) ->
_ ->
TempDir
end,
- InitOpts = ?config(ct_opts, Config),
- [{logdir,LogDir} | InitOpts].
+
+ %% Copy test variables to app environment on new node
+ CtTestVars =
+ case init:get_argument(ct_test_vars) of
+ {ok,[Vars]} ->
+ [begin {ok,Ts,_} = erl_scan:string(Str++"."),
+ {ok,Expr} = erl_parse:parse_term(Ts),
+ Expr
+ end || Str <- Vars];
+ _ ->
+ []
+ end,
+ %% test_server:format("Test variables added to Config: ~p\n\n",
+ %% [CtTestVars]),
+ InitOpts =
+ case proplists:get_value(ct_opts, Config) of
+ undefined -> [];
+ CtOpts -> CtOpts
+ end,
+ [{logdir,LogDir} | InitOpts ++ CtTestVars].
%%%-----------------------------------------------------------------
%%%
run(Opts, Config) ->
- CTNode = ?config(ct_node, Config),
- Level = ?config(trace_level, Config),
+ CTNode = proplists:get_value(ct_node, Config),
+ Level = proplists:get_value(trace_level, Config),
%% use ct interface
test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n",
[Opts, CTNode]),
Result1 = rpc:call(CTNode, ct, run_test, [Opts]),
+ case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of
+ undefined ->
+ ok;
+ _ ->
+ test_server:format(Level,
+ "ct_util_server not stopped on ~p yet, waiting 5 s...~n",
+ [CTNode]),
+ timer:sleep(5000),
+ undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server])
+ end,
%% use run_test interface (simulated)
test_server:format(Level, "Saving start opts on ~p: ~p~n", [CTNode,Opts]),
rpc:call(CTNode, application, set_env, [common_test, run_test_start_opts, Opts]),
@@ -224,8 +255,8 @@ run(Opts, Config) ->
end.
run(M, F, A, Config) ->
- CTNode = ?config(ct_node, Config),
- Level = ?config(trace_level, Config),
+ CTNode = proplists:get_value(ct_node, Config),
+ Level = proplists:get_value(trace_level, Config),
test_server:format(Level, "~nCalling ~w:~w(~p) on ~p~n",
[M, F, A, CTNode]),
rpc:call(CTNode, M, F, A).
@@ -261,11 +292,11 @@ handle_event(EH, Event) ->
ok.
start_event_receiver(Config) ->
- CTNode = ?config(ct_node, Config),
+ CTNode = proplists:get_value(ct_node, Config),
spawn_link(CTNode, fun() -> er() end).
get_events(_, Config) ->
- CTNode = ?config(ct_node, Config),
+ CTNode = proplists:get_value(ct_node, Config),
{event_receiver,CTNode} ! {self(),get_events},
Events = receive {event_receiver,Evs} -> Evs end,
{event_receiver,CTNode} ! stop,
@@ -288,7 +319,7 @@ er_loop(Evs) ->
end.
verify_events(TEvs, Evs, Config) ->
- Node = ?config(ct_node, Config),
+ Node = proplists:get_value(ct_node, Config),
case catch verify_events1(TEvs, Evs, Node, Config) of
{'EXIT',Reason} ->
Reason;
@@ -349,10 +380,15 @@ locate(TEvs, Node, Evs, Config) when is_list(TEvs) ->
data={M,{init_per_group,GroupName,Props}}}},
{TEH,#event{name=tc_done,
node=Node,
- data={M,{init_per_group,GroupName,Props},R}}} | Evs1] ->
- test_server:format("Found ~p!", [InitStart]),
- test_server:format("Found ~p!", [InitDone]),
- verify_events1(TEvs1, Evs1, Node, Config);
+ data={M,{init_per_group,GroupName,Props},Res}}} | Evs1] ->
+ case result_match(R, Res) of
+ false ->
+ nomatch;
+ true ->
+ test_server:format("Found ~p!", [InitStart]),
+ test_server:format("Found ~p!", [InitDone]),
+ verify_events1(TEvs1, Evs1, Node, Config)
+ end;
_ ->
nomatch
end;
@@ -384,9 +420,11 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
EvProps},EvR}}})
when TEH == EH, EvNode == Node, EvM == M,
EvGroupName == GroupName,
- EvProps == Props,
- EvR == R ->
- false;
+ EvProps == Props ->
+ case result_match(R, EvR) of
+ true -> false;
+ false -> true
+ end;
({EH,#event{name=stop_logging,
node=EvNode,data=_}})
when EH == TEH, EvNode == Node ->
@@ -466,7 +504,7 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
node=EvNode,
data={Mod,Func,Result}}} <- Done,
EH == TEH, EvNode == Node, Mod == M,
- Func == F, Result == R] of
+ Func == F, result_match(R, Result)] of
[TcDone|_] ->
test_server:format("Found ~p!", [TEv]),
{lists:delete(TcDone, Done),RemEvs,RemSize};
@@ -509,8 +547,13 @@ locate({parallel,TEvs}, Node, Evs, Config) ->
data={Mod,{end_per_group,
EvGName,EvProps},Res}}}) when
EH == TEH, EvNode == Node, Mod == M,
- EvGName == GroupName, EvProps == Props, Res == R ->
- false;
+ EvGName == GroupName, EvProps == Props ->
+ case result_match(R, Res) of
+ true ->
+ false;
+ false ->
+ true
+ end;
({EH,#event{name=stop_logging,
node=EvNode,data=_}}) when
EH == TEH, EvNode == Node ->
@@ -603,23 +646,29 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
data={M,{init_per_group,GroupName,EvProps}}}},
{TEH,#event{name=tc_done,
node=Node,
- data={M,{init_per_group,GroupName,EvProps},R}}} | Es] ->
- case proplists:get_value(shuffle, Props) of
- '_' ->
- case proplists:get_value(shuffle, EvProps) of
- false ->
- exit({no_shuffle_prop_found,{M,init_per_group,
- GroupName,EvProps}});
+ data={M,{init_per_group,GroupName,EvProps},Res}}} | Es] ->
+ case result_match(R, Res) of
+ true ->
+ case proplists:get_value(shuffle, Props) of
+ '_' ->
+ case proplists:get_value(shuffle, EvProps) of
+ false ->
+ exit({no_shuffle_prop_found,
+ {M,init_per_group,
+ GroupName,EvProps}});
+ _ ->
+ PropsCmp = proplists:delete(shuffle, EvProps),
+ PropsCmp = proplists:delete(shuffle, Props)
+ end;
_ ->
- PropsCmp = proplists:delete(shuffle, EvProps),
- PropsCmp = proplists:delete(shuffle, Props)
- end;
- _ ->
- Props = EvProps
- end,
- test_server:format("Found ~p!", [InitStart]),
- test_server:format("Found ~p!", [InitDone]),
- {TEs,Es};
+ Props = EvProps
+ end,
+ test_server:format("Found ~p!", [InitStart]),
+ test_server:format("Found ~p!", [InitDone]),
+ {TEs,Es};
+ false ->
+ nomatch
+ end;
_ ->
nomatch
end;
@@ -670,7 +719,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
node=EvNode,
data={Mod,Func,Result}}} <- Done,
EH == TEH, EvNode == Node, Mod == M,
- Func == F, Result == R] of
+ Func == F, result_match(R, Result)] of
[TcDone|_] ->
test_server:format("Found ~p!", [TEv]),
{lists:delete(TcDone, Done),RemEvs,RemSize};
@@ -726,8 +775,13 @@ locate({shuffle,TEvs}, Node, Evs, Config) ->
data={Mod,{end_per_group,
EvGName,_},Res}}}) when
EH == TEH, EvNode == Node, Mod == M,
- EvGName == GroupName, Res == R ->
- false;
+ EvGName == GroupName ->
+ case result_match(R, Res) of
+ true ->
+ false;
+ false ->
+ true
+ end;
({EH,#event{name=stop_logging,
node=EvNode,data=_}}) when
EH == TEH, EvNode == Node ->
@@ -864,25 +918,34 @@ locate({TEH,Name,{'DEF','STOP_TIME'}}, Node, [Ev|Evs], Config) ->
nomatch
end;
-%% to match variable data as a result of a failed test case
-locate({TEH,tc_done,{Mod,Func,{failed,{error,{Slogan,'_'}}}}}, Node, [Ev|Evs], Config) ->
+%% to match variable data as a result of an aborted test case
+locate({TEH,tc_done,{undefined,undefined,{testcase_aborted,
+ {abort_current_testcase,Func},'_'}}},
+ Node, [Ev|Evs], Config) ->
case Ev of
- {TEH,#event{name=tc_done, node=Node,
- data={Mod,Func,{failed,{error,{Slogan,_}}}}}} ->
+ {TEH,#event{name=tc_done, node=Node,
+ data={undefined,undefined,
+ {testcase_aborted,{abort_current_testcase,Func},_}}}} ->
{Config,Evs};
_ ->
nomatch
end;
-%% to match variable data as a result of an aborted test case
-locate({TEH,tc_done,{undefined,undefined,{testcase_aborted,
- {abort_current_testcase,Func},'_'}}},
- Node, [Ev|Evs], Config) ->
+%% to match variable data as a result of a failed test case
+locate({TEH,tc_done,{Mod,Func,R={SkipOrFail,{_ErrInd,ErrInfo}}}},
+ Node, [Ev|Evs], Config) when ((SkipOrFail == skipped) or
+ (SkipOrFail == failed)) and
+ ((size(ErrInfo) == 2) or
+ (size(ErrInfo) == 3)) ->
case Ev of
{TEH,#event{name=tc_done, node=Node,
- data={undefined,undefined,
- {testcase_aborted,{abort_current_testcase,Func},_}}}} ->
- {Config,Evs};
+ data={Mod,Func,Result}}} ->
+ case result_match(R, Result) of
+ true ->
+ {Config,Evs};
+ false ->
+ nomatch
+ end;
_ ->
nomatch
end;
@@ -931,14 +994,27 @@ match_data(Tuple1,Tuple2) when is_tuple(Tuple1),is_tuple(Tuple2) ->
match_data([],[]) ->
match.
-log_events(TC, Events, PrivDir) ->
- LogFile = filename:join(PrivDir, atom_to_list(TC)++".events"),
+result_match({SkipOrFail,{ErrorInd,{Why,'_'}}},
+ {SkipOrFail,{ErrorInd,{Why,_Stack}}}) ->
+ true;
+result_match({SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,'_'}}}},
+ {SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,_Stack}}}}) ->
+ true;
+result_match(Result, Result) ->
+ true;
+result_match(_, _) ->
+ false.
+
+log_events(TC, Events, EvLogDir, Opts) ->
+ LogFile = filename:join(EvLogDir, atom_to_list(TC)++".events"),
{ok,Dev} = file:open(LogFile, [write]),
io:format(Dev, "[~n", []),
log_events1(Events, Dev, " "),
file:close(Dev),
+ FullLogFile = join_abs_dirs(proplists:get_value(net_dir, Opts),
+ LogFile),
io:format("Events written to logfile: <a href=\"file://~s\">~s</a>~n",
- [LogFile,LogFile]),
+ [FullLogFile,FullLogFile]),
io:format(user, "Events written to logfile: ~p~n", [LogFile]).
log_events1(Evs, Dev, "") ->
@@ -1024,13 +1100,25 @@ reformat([], _EH) ->
%%%-----------------------------------------------------------------
%%% MISC HELP FUNCTIONS
+join_abs_dirs(undefined, Dir2) ->
+ Dir2;
+join_abs_dirs(Dir1, Dir2) ->
+ case filename:pathtype(Dir2) of
+ relative ->
+ filename:join(Dir1, Dir2);
+ _ ->
+ [_Abs|Parts] = filename:split(Dir2),
+ filename:join(Dir1, filename:join(Parts))
+ end.
+
create_tmp_logdir(Tmp) ->
LogDir = filename:join(Tmp,"ct"),
file:make_dir(LogDir),
LogDir.
delete_old_logs({win32,_}, Config) ->
- case {?config(priv_dir, Config),?config(logdir, get_opts(Config))} of
+ case {proplists:get_value(priv_dir, Config),
+ proplists:get_value(logdir, get_opts(Config))} of
{LogDir,LogDir} ->
ignore;
{_,LogDir} -> % using tmp for logs
@@ -1042,7 +1130,8 @@ delete_old_logs(_, Config) ->
false ->
ignore;
_ ->
- catch delete_dirs(?config(logdir, get_opts(Config)))
+ catch delete_dirs(proplists:get_value(logdir,
+ get_opts(Config)))
end.
delete_dirs(LogDir) ->
diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl
index 616c2db869..b6dcf63fdf 100644
--- a/lib/common_test/test/ct_testspec_1_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_1_SUITE.erl
@@ -612,6 +612,12 @@ setup_and_execute(TCName, TestSpec, Config) ->
false -> [{spec,SpecFile},{label,TCName}]
end,
{Opts,ERPid} = setup(TestTerms, Config),
+
+ FullSpecFile = ct_test_support:join_abs_dirs(?config(net_dir, Opts),
+ SpecFile),
+ io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n",
+ [FullSpecFile,FullSpecFile]),
+
ok = ct_test_support:run(Opts, Config),
TestSpec1 = [{logdir,proplists:get_value(logdir,Opts)},
{label,proplists:get_value(label,TestTerms)} | TestSpec],
@@ -620,7 +626,8 @@ setup_and_execute(TCName, TestSpec, Config) ->
ct_test_support:log_events(TCName,
reformat(Events, ?eh),
- ?config(priv_dir, Config)),
+ ?config(priv_dir, Config),
+ Opts),
TestEvents = events_to_check(TCName),
ok = ct_test_support:verify_events(TestEvents, Events, Config).
@@ -631,8 +638,6 @@ create_spec_file(SpecDir, TCName, TestSpec) ->
{ok,Dev} = file:open(FileName, [write]),
[io:format(Dev, "~p.~n", [Term]) || Term <- TestSpec],
file:close(Dev),
- io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n",
- [FileName,FileName]),
FileName.
setup(Test, Config) when is_tuple(Test) ->
@@ -791,7 +796,9 @@ test_events(skip_group) ->
{?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}},
{?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}},
- {?eh,test_stats,{2,0,{1,0}}},
+ {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_2},"SKIPPED!"}},
+ %%! But not test_group_7 since it's a sub-group!
+ {?eh,test_stats,{2,0,{2,0}}},
{negative,{?eh,tc_user_skip,'_'},{?eh,stop_logging,'_'}}
];
@@ -1188,10 +1195,9 @@ test_events(sub_skipped_by_top) ->
{?eh,tc_start,{groups_12_SUITE,init_per_suite}},
{?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}},
+ {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}},
- {negative,
- {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}},
- {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}},
+ {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}},
{negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}}
];
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index 2a36fda1ea..5cc8252b99 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) ->
warning_translate_label(Term, D) when is_tuple(Term) ->
case element(1, Term) of
{label,F} ->
- case gb_trees:lookup(F, D) of
- none -> Term;
- {value,FA} -> setelement(1, Term, FA)
- end;
+ FA = gb_trees:get(F, D),
+ setelement(1, Term, FA);
_ -> Term
end;
warning_translate_label(Term, _) -> Term.
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index bb93110176..8e96569414 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% We must split the basic block when we encounter instructions with labels,
%% such as catches and BIFs. All labels must be visible outside the blocks.
-%% Also remove empty blocks.
split_blocks({function,Name,Arity,CLabel,Is0}) ->
Is = split_blocks(Is0, []),
{function,Name,Arity,CLabel,Is}.
-split_blocks([{block,[]}|Is], Acc) ->
- split_blocks(Is, Acc);
split_blocks([{block,Bl}|Is], Acc0) ->
Acc = split_block(Bl, [], Acc0),
split_blocks(Is, Acc);
@@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) ->
D = update_value_dict(List, Reg, D0),
forward(Is, D, Lc, [I|Acc]);
forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Block = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Blk; %Must keep move instruction.
- true -> {block,BlkIs} %Safe to remove move instruction.
- end;
- _ -> Blk %Keep move instruction.
+ {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction.
+ _ -> Blk %Must keep move instruction.
end,
forward([Block|Is], D, Lc, [LblI|Acc]);
forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Is = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Is0; %Must keep move instruction.
- true -> Is1 %Safe to remove move instruction.
- end;
- _ -> Is0 %Keep move instruction.
- end,
+ {value,Lit} -> Is1; %Safe to remove move instruction.
+ _ -> Is0 %Keep move instruction.
+ end,
forward(Is, D, Lc, [LblI|Acc]);
forward([{test,is_eq_exact,_,[Dst,Src]}=I,
{block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) ->
@@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
Key = {Lbl,Reg},
D = case gb_trees:lookup(Key, D0) of
none -> gb_trees:insert(Key, Lit, D0); %New.
- {value,Lit} -> D0; %Already correct.
{value,inconsistent} -> D0; %Inconsistent.
{value,_} -> gb_trees:update(Key, inconsistent, D0)
end,
update_value_dict(T, Reg, D);
update_value_dict([], _, D) -> D.
-is_unreachable_after([I|_]) ->
- beam_jump:is_unreachable_after(I).
-
%%%
%%% Scan instructions in reverse execution order and remove dead code.
%%%
@@ -602,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) ->
count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) ->
%% The save point we are looking for - we are done.
Bits;
-count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) ->
- %% Another save point - keep counting.
- count_bits_matched(Is, SavePoint, Bits);
count_bits_matched([_|_], _, Bits) -> Bits.
shortcut_bs_pos_used(To, Reg, D) ->
shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D).
-shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) ->
- false;
shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) ->
false;
shortcut_bs_pos_used_1(Is, Reg, D) ->
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index cab22e03d0..f7388f1614 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(andor_SUITE),
+ test_lib:recompile(?MODULE),
[t_case, t_and_or, t_andalso, t_orelse, inside, overlap,
combined, in_case, before_and_inside_if].
diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl
index c517c4465e..25f8a8dfb5 100644
--- a/lib/compiler/test/apply_SUITE.erl
+++ b/lib/compiler/test/apply_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(apply_SUITE),
+ test_lib:recompile(?MODULE),
[mfa, fun_apply].
groups() ->
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index fc88ebeb41..556dc54a8f 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -46,7 +46,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(beam_validator_SUITE),
+ test_lib:recompile(?MODULE),
[beam_files, compiler_bug, stupid_but_valid, xrange,
yrange, stack, call_last, merge_undefined, uninit,
unsafe_catch, dead_code, mult_labels,
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index 30c04f80cf..d39e340429 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -32,7 +32,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_bincomp_SUITE),
+ test_lib:recompile(?MODULE),
[byte_aligned, bit_aligned, extended_byte_aligned,
extended_bit_aligned, mixed, filters, trim_coverage,
nomatch, sizes, tail].
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index 8be0c4196a..30276f1259 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -33,7 +33,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_bit_binaries_SUITE),
+ test_lib:recompile(?MODULE),
[misc, horrid_match, test_bitstr, test_bit_size,
asymmetric_tests, big_asymmetric_tests,
binary_to_and_from_list, big_binary_to_and_from_list,
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index c430b12b70..31c7890f26 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -35,7 +35,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_construct_SUITE),
+ test_lib:recompile(?MODULE),
[two, test1, fail, float_bin, in_guard, in_catch,
nasty_literals, side_effect, opt, otp_7556, float_arith,
otp_8054].
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 9184e14cb2..6a795f6634 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -35,7 +35,7 @@
match_string/1,zero_width/1,bad_size/1,haystack/1,
cover_beam_bool/1]).
--export([coverage_id/1]).
+-export([coverage_id/1,coverage_external_ignore/2]).
-include_lib("test_server/include/test_server.hrl").
@@ -43,7 +43,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_match_SUITE),
+ test_lib:recompile(?MODULE),
[fun_shadow, int_float, otp_5269, null_fields, wiger,
bin_tail, save_restore, shadowed_size_var,
partitioned_bs_match, function_clause, unit,
@@ -585,13 +585,17 @@ coverage(Config) when is_list(Config) ->
A+B
end, 0, [a,b,c])),
+ ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float),
?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple),
?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} =
coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}),
+ ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []),
+
?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}),
?line [42] = coverage_apply(<<42>>, [coverage_id]),
+ ?line 42 = coverage_external(<<42>>),
?line do_coverage_bin_to_term_list([]),
?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]),
@@ -608,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) ->
coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T);
coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc.
+coverage_build(Acc0, <<H,T/binary>>, float) ->
+ Float = id(<<H:64/float>>),
+ Acc = <<Acc0/binary,Float/binary>>,
+ coverage_build(Acc, T, float);
coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
Str = id(<<H:(id(4)),(H-1):4,"abc">>),
Acc = id(<<Acc0/bitstring,Str/bitstring>>),
@@ -618,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
end;
coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}.
+coverage_bc(<<H,T/binary>>, Acc) ->
+ B = << <<C:8>> || C <- [H] >>,
+ coverage_bc(T, [B|Acc]);
+coverage_bc(<<>>, Acc) -> Acc.
+
coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x ->
setelement(H, Tuple, T1).
@@ -625,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) ->
[?MODULE:F(H)|coverage_apply(T, Fs)];
coverage_apply(<<>>, []) -> [].
+coverage_external(<<H,T/binary>>) ->
+ ?MODULE:coverage_external_ignore(T, T),
+ H.
+
+coverage_external_ignore(_, _) ->
+ ok.
+
coverage_id(I) -> id(I).
do_coverage_bin_to_term_list(L) ->
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index d37943ce3a..f30a4d3fef 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(bs_utf_SUITE),
+ test_lib:recompile(?MODULE),
[utf8_roundtrip, unused_utf_char, utf16_roundtrip,
utf32_roundtrip, guard, extreme_tripping, literals,
coverage].
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index ba225b66d0..1343fbd1c9 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(compilation_SUITE),
+ test_lib:recompile(?MODULE),
[self_compile_old_inliner, self_compile, compiler_1,
compiler_3, compiler_5, beam_compiler_1,
beam_compiler_2, beam_compiler_3, beam_compiler_4,
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 037c078fd0..b3e5376ffd 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> all_return_type().
all() ->
- test_lib:recompile(compile_SUITE),
+ test_lib:recompile(?MODULE),
[app_test, file_1, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, package_forms, encrypted_abstr,
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 21a5f65dee..26173c62b8 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -40,7 +40,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(core_SUITE),
+ test_lib:recompile(?MODULE),
[dehydrated_itracer, nested_tries].
groups() ->
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 710751b09d..ac14d36e82 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(core_fold_SUITE),
+ test_lib:recompile(?MODULE),
[t_element, setelement, t_length, append, t_apply, bifs,
eq, nested_call_in_case, coverage].
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index c9823665b4..6e0aadf007 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(error_SUITE),
+ test_lib:recompile(?MODULE),
[head_mismatch_line, warnings_as_errors, bif_clashes].
groups() ->
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index 6738265776..afc04fd440 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -26,7 +26,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(float_SUITE),
+ test_lib:recompile(?MODULE),
[pending, bif_calls, math_functions,
mixed_float_and_int].
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index aa9be83c82..368a5815bf 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -27,7 +27,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(fun_SUITE),
+ test_lib:recompile(?MODULE),
[test1, overwritten_fun, otp_7202, bif_fun].
groups() ->
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 482564a32b..0e69efba6b 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -37,7 +37,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(guard_SUITE),
+ test_lib:recompile(?MODULE),
[misc, const_cond, basic_not, complex_not, nested_nots,
semicolon, complex_semicolon, comma, or_guard,
more_or_guards, complex_or_guards, and_guard, xor_guard,
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 7b9600c2f6..af2b8ec92a 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -31,7 +31,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(inline_SUITE),
+ test_lib:recompile(?MODULE),
[attribute, bsdecode, bsdes, barnes2, decode1, smith,
itracer, pseudoknot, lists, really_inlined, otp_7223,
coverage].
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index bcdcf2fd9f..c8908858ba 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(lc_SUITE),
+ test_lib:recompile(?MODULE),
[basic, deeply_nested, no_generator, empty_generator].
groups() ->
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 04879300d1..9406d7de8f 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -22,16 +22,16 @@
init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,match_in_call/1,
untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1,underscore/1]).
+ selectify/1,underscore/1,coverage/1]).
-include_lib("test_server/include/test_server.hrl").
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(match_SUITE),
+ test_lib:recompile(?MODULE),
[pmatch, mixed, aliases, match_in_call, untuplify,
- shortcut_boolean, letify_guard, selectify, underscore].
+ shortcut_boolean, letify_guard, selectify, underscore, coverage].
groups() ->
[].
@@ -398,4 +398,18 @@ underscore(Config) when is_list(Config) ->
_ = is_list(Config),
ok.
+coverage(Config) when is_list(Config) ->
+ %% Cover beam_dead.
+ ok = coverage_1(x, a),
+ ok = coverage_1(x, b).
+
+coverage_1(B, Tag) ->
+ case Tag of
+ a -> coverage_2(1, a, B);
+ b -> coverage_2(2, b, B)
+ end.
+
+coverage_2(1, a, x) -> ok;
+coverage_2(2, b, x) -> ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index f1f9b17084..c941a80e61 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
-spec all() -> misc_SUITE_test_cases().
all() ->
- test_lib:recompile(misc_SUITE),
+ test_lib:recompile(?MODULE),
[tobias, empty_string, md5, silly_coverage,
confused_literals, integer_encoding, override_bif].
diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl
index 0a4750dc08..3479cf5425 100644
--- a/lib/compiler/test/num_bif_SUITE.erl
+++ b/lib/compiler/test/num_bif_SUITE.erl
@@ -40,7 +40,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(num_bif_SUITE),
+ test_lib:recompile(?MODULE),
[t_abs, t_float, t_float_to_list, t_integer_to_list,
{group, t_list_to_float}, t_list_to_integer, t_round,
t_trunc].
diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl
index 4c68d777ca..9a317b5762 100644
--- a/lib/compiler/test/pmod_SUITE.erl
+++ b/lib/compiler/test/pmod_SUITE.erl
@@ -28,7 +28,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(pmod_SUITE),
+ test_lib:recompile(?MODULE),
[basic, otp_8447].
groups() ->
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index 75e8045693..2a67615e5e 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -39,7 +39,7 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(receive_SUITE),
+ test_lib:recompile(?MODULE),
[recv, coverage, otp_7980, ref_opt, export].
groups() ->
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index 65b96590ed..363422ec7e 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -26,7 +26,8 @@
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1,
- guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, nested_access/1]).
+ guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1,
+ nested_access/1,coverage/1]).
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:minutes(2)),
@@ -40,10 +41,10 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(record_SUITE),
+ test_lib:recompile(?MODULE),
[errors, record_test_2, record_test_3,
record_access_in_guards, guard_opt, eval_once, foobar,
- missing_test_heap, nested_access].
+ missing_test_heap, nested_access, coverage].
groups() ->
[].
@@ -568,4 +569,18 @@ nested_access(Config) when is_list(Config) ->
?line N2a = N2b,
ok.
+-record(rr, {a,b,c}).
+
+coverage(Config) when is_list(Config) ->
+ %% There should only remain one record test in the code below.
+ R0 = id(#rr{a=1,b=2,c=3}),
+ B = R0#rr.b, %Test the record here.
+ R = R0#rr{c=42}, %No need to test here.
+ if
+ B > R#rr.a -> %No need to test here.
+ ok
+ end,
+ #rr{a=1,b=2,c=42} = id(R), %Test for correctness.
+ ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 92a79d3cba..c6e0f8d85d 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -31,7 +31,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(trycatch_SUITE),
+ test_lib:recompile(?MODULE),
[basic, lean_throw, try_of, try_after, catch_oops,
after_oops, eclectic, rethrow, nested_of, nested_catch,
nested_after, nested_horrid, last_call_optimization,
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index dd18a6e1a3..f6a572abfa 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -54,7 +54,7 @@ end_per_testcase(_Case, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- test_lib:recompile(warnings_SUITE),
+ test_lib:recompile(?MODULE),
[pattern, pattern2, pattern3, pattern4, guard,
bad_arith, bool_cases, bad_apply, files, effect,
bin_opt_info, bin_construction].
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index b8786f6f94..3ebf62d87c 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -134,7 +134,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T
static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -204,7 +206,9 @@ static ErlNifFunc nif_funcs[] = {
{"aes_ctr_encrypt", 3, aes_ctr_encrypt},
{"aes_ctr_decrypt", 3, aes_ctr_encrypt},
{"rand_bytes", 1, rand_bytes_1},
+ {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif},
{"rand_bytes", 3, rand_bytes_3},
+ {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif},
{"rand_uniform_nif", 2, rand_uniform_nif},
{"mod_exp_nif", 3, mod_exp_nif},
{"dss_verify", 4, dss_verify},
@@ -704,6 +708,22 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes);
return ret;
}
+static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Bytes) */
+ unsigned bytes;
+ unsigned char* data;
+ ERL_NIF_TERM ret;
+ if (!enif_get_uint(env, argv[0], &bytes)) {
+ return enif_make_badarg(env);
+ }
+ data = enif_make_new_binary(env, bytes, &ret);
+ if ( RAND_bytes(data, bytes) != 1) {
+ return atom_false;
+ }
+ ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes);
+ return ret;
+}
+
static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Bytes, TopMask, BottomMask) */
unsigned bytes;
@@ -724,6 +744,47 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
}
return ret;
}
+static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Bytes, TopMask, BottomMask) */
+ unsigned bits;
+ BIGNUM *bn_rand;
+ int top, bottom;
+ unsigned char* data;
+ unsigned dlen;
+ ERL_NIF_TERM ret;
+ if (!enif_get_uint(env, argv[0], &bits)
+ || !enif_get_int(env, argv[1], &top)
+ || !enif_get_int(env, argv[2], &bottom)) {
+ return enif_make_badarg(env);
+ }
+ if (! (top == -1 || top == 0 || top == 1) ) {
+ return enif_make_badarg(env);
+ }
+ if (! (bottom == 0 || bottom == 1) ) {
+ return enif_make_badarg(env);
+ }
+
+ bn_rand = BN_new();
+ if (! bn_rand ) {
+ return enif_make_badarg(env);
+ }
+
+ /* Get a (bits) bit random number */
+ if (!BN_rand(bn_rand, bits, top, bottom)) {
+ ret = atom_false;
+ }
+ else {
+ /* Copy the bignum into an erlang mpint binary. */
+ dlen = BN_num_bytes(bn_rand);
+ data = enif_make_new_binary(env, dlen+4, &ret);
+ put_int32(data, dlen);
+ BN_bn2bin(bn_rand, data+4);
+ ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen);
+ }
+ BN_free(bn_rand);
+
+ return ret;
+}
static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp)
{
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index dfafe67348..1ccea6df79 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -619,6 +619,21 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>strong_rand_bytes(N) -> binary()</name>
+ <fsummary>Generate a binary of random bytes</fsummary>
+ <type>
+ <v>N = integer()</v>
+ </type>
+ <desc>
+ <p>Generates N bytes randomly uniform 0..255, and returns the
+ result in a binary. Uses a cryptographically secure prng seeded and
+ periodically mixed with operating system provided entropy. By default
+ this is the <c>RAND_bytes</c> method from OpenSSL.</p>
+ <p>May throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".</p>
+ </desc>
+ </func>
+ <func>
<name>rand_uniform(Lo, Hi) -> N</name>
<fsummary>Generate a random number</fsummary>
<type>
@@ -633,6 +648,31 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]>
</desc>
</func>
<func>
+ <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name>
+ <fsummary>Generate an N bit random number</fsummary>
+ <type>
+ <v>N = non_neg_integer()</v>
+ <v>Top = -1 | 0 | 1</v>
+ <v>Bottom = 0 | 1</v>
+ <v>Mpint = binary()</v>
+ </type>
+ <desc>
+ <p>Generate an N bit random number using OpenSSL's
+ cryptographically strong pseudo random number generator
+ <c>BN_rand</c>.</p>
+ <p>The parameter <c>Top</c> places constraints on the most
+ significant bits of the generated number. If <c>Top</c> is 1, then the
+ two most significant bits will be set to 1, if <c>Top</c> is 0, the
+ most significant bit will be 1, and if <c>Top</c> is -1 then no
+ constraints are applied and thus the generated number may be less than
+ N bits long.</p>
+ <p>If <c>Bottom</c> is 1, then the generated number is
+ constrained to be odd.</p>
+ <p>May throw exception <c>low_entropy</c> in case the random generator
+ failed due to lack of secure "randomness".</p>
+ </desc>
+ </func>
+ <func>
<name>mod_exp(N, P, M) -> Result</name>
<fsummary>Perform N ^ P mod M</fsummary>
<type>
diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml
index 5e9bda3920..ab1ffa9e5c 100644
--- a/lib/crypto/doc/src/notes.xml
+++ b/lib/crypto/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1999</year><year>2010</year>
+ <year>1999</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -30,6 +30,21 @@
</header>
<p>This document describes the changes made to the Crypto application.</p>
+<section><title>Crypto 2.0.2.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Strengthened random number generation. (Thanks to Geoff Cant)</p>
+ <p>
+ Own Id: OTP-9225</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Crypto 2.0.2.1</title>
<section><title>Improvements and New Features</title>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index d6e2e033c0..cc7b3acc9c 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -46,6 +46,7 @@
-export([rsa_private_encrypt/3, rsa_public_decrypt/3]).
-export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]).
-export([rand_bytes/1, rand_bytes/3, rand_uniform/2]).
+-export([strong_rand_bytes/1, strong_rand_mpint/3]).
-export([mod_exp/3, mpint/1, erlint/1]).
%% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]).
-export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]).
@@ -68,6 +69,8 @@
des_ede3_cbc_encrypt, des_ede3_cbc_decrypt,
aes_cfb_128_encrypt, aes_cfb_128_decrypt,
rand_bytes,
+ strong_rand_bytes,
+ strong_rand_mpint,
rand_uniform,
mod_exp,
dss_verify,dss_sign,
@@ -361,12 +364,32 @@ aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub.
%% RAND - pseudo random numbers using RN_ functions in crypto lib
%%
-spec rand_bytes(non_neg_integer()) -> binary().
+-spec strong_rand_bytes(non_neg_integer()) -> binary().
-spec rand_uniform(crypto_integer(), crypto_integer()) ->
crypto_integer().
+-spec strong_rand_mpint(Bits::non_neg_integer(),
+ Top::-1..1,
+ Bottom::0..1) -> binary().
rand_bytes(_Bytes) -> ?nif_stub.
+
+strong_rand_bytes(Bytes) ->
+ case strong_rand_bytes_nif(Bytes) of
+ false -> erlang:error(low_entropy);
+ Bin -> Bin
+ end.
+strong_rand_bytes_nif(_Bytes) -> ?nif_stub.
+
rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub.
+strong_rand_mpint(Bits, Top, Bottom) ->
+ case strong_rand_mpint_nif(Bits,Top,Bottom) of
+ false -> erlang:error(low_entropy);
+ Bin -> Bin
+ end.
+strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub.
+
+
rand_uniform(From,To) when is_binary(From), is_binary(To) ->
case rand_uniform_nif(From,To) of
<<Len:32/integer, MSB, Rest/binary>> when MSB > 127 ->
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index fe8f8e69a0..854a8b4485 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -46,6 +46,7 @@
aes_ctr/1,
mod_exp_test/1,
rand_uniform_test/1,
+ strong_rand_test/1,
rsa_verify_test/1,
dsa_verify_test/1,
rsa_sign_test/1,
@@ -68,7 +69,8 @@ all() ->
md5_mac_io, sha, sha_update,
%% sha256, sha256_update, sha512,sha512_update,
des_cbc, aes_cfb, aes_cbc,
- aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test,
+ aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb,
+ rand_uniform_test, strong_rand_test,
rsa_verify_test, dsa_verify_test, rsa_sign_test,
dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test,
rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64,
@@ -710,6 +712,33 @@ rand_uniform_aux_test(N) ->
%%
%%
+strong_rand_test(doc) ->
+ "strong_rand_mpint and strong_random_bytes testing";
+strong_rand_test(suite) ->
+ [];
+strong_rand_test(Config) when is_list(Config) ->
+ strong_rand_aux_test(180),
+ ?line 10 = byte_size(crypto:strong_rand_bytes(10)).
+
+strong_rand_aux_test(0) ->
+ ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>),
+ ok;
+strong_rand_aux_test(1) ->
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1),
+ ?line strong_rand_aux_test(0);
+strong_rand_aux_test(N) ->
+ ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N),
+ ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N),
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1),
+ ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11),
+ ?line strong_rand_aux_test(N-1).
+
+sru_length(Mpint) ->
+ I = crypto:erlint(Mpint),
+ length(erlang:integer_to_list(I, 2)).
+
+%%
+%%
%%
%%
rsa_verify_test(doc) ->
@@ -1097,7 +1126,7 @@ worker_loop(0, _) ->
ok;
worker_loop(N, Config) ->
Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc,
- aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test,
+ aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test,
rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test },
F = element(random:uniform(size(Funcs)),Funcs),
diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk
index e2d6fd0b37..740c68d8fa 100644
--- a/lib/crypto/vsn.mk
+++ b/lib/crypto/vsn.mk
@@ -1 +1 @@
-CRYPTO_VSN = 2.0.2.1
+CRYPTO_VSN = 2.0.2.2
diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt
index 1d7a1a6222..d519ac960b 100644
--- a/lib/dialyzer/doc/manual.txt
+++ b/lib/dialyzer/doc/manual.txt
@@ -37,7 +37,7 @@ The parameters are:
The analysis starts from .beam bytecode files.
The files must be compiled with +debug_info.
- Source code:
- The analysis starts from .erl files.
+ The analysis starts from .erl files.
Controlling the discrepancies reported by the Dialyzer
======================================================
@@ -131,7 +131,7 @@ Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose]
[--check_plt] [--no_check_plt] [--plt_info] [--get_warnings]
[--no_native] [--fullpath]
-Options:
+Options:
files_or_dirs (for backwards compatibility also as: -c files_or_dirs)
Use Dialyzer from the command line to detect defects in the
specified files or directories containing .erl or .beam files,
@@ -169,7 +169,7 @@ Options:
--output_plt file
Store the plt at the specified file after building it.
--plt plt
- Use the specified plt as the initial plt (if the plt was built
+ Use the specified plt as the initial plt (if the plt was built
during setup the files will be checked for consistency).
--plts plt*
Merge the specified plts to create the initial plt -- requires
@@ -204,8 +204,8 @@ Options:
--add_to_plt
The plt is extended to also include the files specified with -c and -r.
Use --plt to specify which plt to start from, and --output_plt to
- specify where to put the plt. Note that the analysis might include
- files from the plt if they depend on the new files.
+ specify where to put the plt. Note that the analysis might include
+ files from the plt if they depend on the new files.
This option only works with beam files.
--remove_from_plt
The information from the files specified with -c and -r is removed
@@ -269,13 +269,13 @@ Warning options:
Include warnings about behaviour callbacks which drift from the published
recommended interfaces.
-Wunderspecs ***
- Warn about underspecified functions
+ Warn about underspecified functions
(those whose -spec is strictly more allowing than the success typing).
The following options are also available but their use is not recommended:
(they are mostly for Dialyzer developers and internal debugging)
-Woverspecs ***
- Warn about overspecified functions
+ Warn about overspecified functions
(those whose -spec is strictly less allowing than the success typing).
-Wspecdiffs ***
Warn when the -spec is different than the success typing.
@@ -306,8 +306,8 @@ dialyzer:run(OptList) -> Warnings
Warnings :: [{tag(), id(), msg()}]
tag() :: 'warn_return_no_exit' | 'warn_return_only_exit' | 'warn_not_called'
| 'warn_non_proper_list' | 'warn_fun_app' | 'warn_matching'
- | 'warn_failing_call' | 'warn_contract_types'
- | 'warn_contract_syntax' | 'warn_contract_not_equal'
+ | 'warn_failing_call' | 'warn_contract_types'
+ | 'warn_contract_syntax' | 'warn_contract_not_equal'
| 'warn_contract_subtype' | 'warn_contract_supertype'
id() :: {File :: string(), Line :: integer()}
msg() :: Undefined
@@ -319,24 +319,31 @@ Option :: {files, [Filename :: string()]}
| {from, src_code | byte_code} %% Defaults to byte_code
| {init_plt, FileName :: string()} %% If changed from default
| {plts, [FileName :: string()]} %% If changed from default
- | {include_dirs, [DirName :: string()]}
+ | {include_dirs, [DirName :: string()]}
| {output_file, FileName :: string()}
| {output_plt, FileName :: string()}
| {analysis_type, 'succ_typings' | 'plt_add' |
'plt_build' | 'plt_check' | 'plt_remove'}
| {warnings, [WarnOpts]}
+ | {get_warnings, bool()}
WarnOpts :: no_return
| no_unused
| no_improper_lists
| no_fun_app
| no_match
+ | no_opaque
| no_fail_call
- | unmatched_returns
| error_handling
+ | race_conditions
+ | behaviours
+ | unmatched_returns
+ | overspecs
+ | underspecs
+ | specdiffs
dialyzer:format_warning({tag(), id(), msg()}) -> string()
-
+
Returns a string representation of the warnings as returned by dialyzer:run/1.
dialyzer:plt_info(string()) -> {'ok', [{atom(), any()}]} | {'error', atom()}
@@ -392,7 +399,7 @@ files that depend on these files. Note that this consistency check
will be performed automatically the next time you run Dialyzer with
this plt. The --check_plt option is merely for doing so without doing
any other analysis.
-
+
-----------------------------------------------
--
-- Feedback & bug reports
diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml
index b6547b11e1..4080dfdf77 100644
--- a/lib/dialyzer/doc/src/dialyzer.xml
+++ b/lib/dialyzer/doc/src/dialyzer.xml
@@ -241,7 +241,7 @@
<item>Include warnings about behaviour callbacks which drift from the
published recommended interfaces.</item>
<tag><c><![CDATA[-Wunderspecs]]></c>***</tag>
- <item>Warn about underspecified functions
+ <item>Warn about underspecified functions
(the -spec is strictly more allowing than the success typing).</item>
</taglist>
<p>The following options are also available but their use is not
@@ -249,7 +249,7 @@
debugging)</p>
<taglist>
<tag><c><![CDATA[-Woverspecs]]></c>***</tag>
- <item>Warn about overspecified functions
+ <item>Warn about overspecified functions
(the -spec is strictly less allowing than the success typing).</item>
<tag><c><![CDATA[-Wspecdiffs]]></c>***</tag>
<item>Warn when the -spec is different than the success typing.</item>
@@ -278,34 +278,34 @@
<desc>
<p>Dialyzer GUI version.</p>
<code type="none"><![CDATA[
-OptList : [Option]
-Option : {files, [Filename : string()]}
- | {files_rec, [DirName : string()]}
- | {defines, [{Macro: atom(), Value : term()}]}
- | {from, src_code | byte_code} %% Defaults to byte_code
- | {init_plt, FileName : string()} %% If changed from default
- | {plts, [FileName :: string()]} %% If changed from default
- | {include_dirs, [DirName : string()]}
- | {output_file, FileName : string()}
- | {output_plt, FileName :: string()}
- | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'}
- | {warnings, [WarnOpts]}
- | {get_warnings, bool()}
+OptList :: [Option]
+Option :: {files, [Filename :: string()]}
+ | {files_rec, [DirName :: string()]}
+ | {defines, [{Macro: atom(), Value : term()}]}
+ | {from, src_code | byte_code} %% Defaults to byte_code
+ | {init_plt, FileName :: string()} %% If changed from default
+ | {plts, [FileName :: string()]} %% If changed from default
+ | {include_dirs, [DirName :: string()]}
+ | {output_file, FileName :: string()}
+ | {output_plt, FileName :: string()}
+ | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'}
+ | {warnings, [WarnOpts]}
+ | {get_warnings, bool()}
-WarnOpts : no_return
- | no_unused
- | no_improper_lists
- | no_fun_app
- | no_match
- | no_opaque
- | no_fail_call
- | error_handling
- | race_conditions
- | behaviours
- | unmatched_returns
- | overspecs
- | underspecs
- | specdiffs
+WarnOpts :: no_return
+ | no_unused
+ | no_improper_lists
+ | no_fun_app
+ | no_match
+ | no_opaque
+ | no_fail_call
+ | error_handling
+ | race_conditions
+ | behaviours
+ | unmatched_returns
+ | overspecs
+ | underspecs
+ | specdiffs
]]></code>
</desc>
</func>
@@ -320,12 +320,12 @@ WarnOpts : no_return
<p>Dialyzer command line version.</p>
<code type="none"><![CDATA[
Warnings :: [{Tag, Id, Msg}]
-Tag : 'warn_return_no_exit' | 'warn_return_only_exit'
- | 'warn_not_called' | 'warn_non_proper_list'
- | 'warn_fun_app' | 'warn_matching'
- | 'warn_failing_call' | 'warn_contract_types'
- | 'warn_contract_syntax' | 'warn_contract_not_equal'
- | 'warn_contract_subtype' | 'warn_contract_supertype'
+Tag :: 'warn_return_no_exit' | 'warn_return_only_exit'
+ | 'warn_not_called' | 'warn_non_proper_list'
+ | 'warn_fun_app' | 'warn_matching'
+ | 'warn_failing_call' | 'warn_contract_types'
+ | 'warn_contract_syntax' | 'warn_contract_not_equal'
+ | 'warn_contract_subtype' | 'warn_contract_supertype'
Id = {File :: string(), Line :: integer()}
Msg = msg() -- Undefined
]]></code>
diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl
index 24d6013692..b8da57d3f9 100644
--- a/lib/dialyzer/src/dialyzer_succ_typings.erl
+++ b/lib/dialyzer/src/dialyzer_succ_typings.erl
@@ -155,19 +155,24 @@ postprocess_dataflow_warns(RawWarnings, State, WarnAcc) ->
postprocess_dataflow_warns([], _State, WAcc, Acc) ->
{WAcc, lists:reverse(Acc)};
-postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {File, CallL}, Msg}|Rest],
+postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest],
#st{codeserver = Codeserver} = State, WAcc, Acc) ->
{contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg,
- {ok, {{File, _ContrL} = FileLine, _C}} =
+ {ok, {{ContrF, _ContrL} = FileLine, _C}} =
dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver),
- NewMsg =
- {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
- W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg},
- Filter =
- fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false;
- (_) -> true
- end,
- postprocess_dataflow_warns(Rest, State, lists:filter(Filter, WAcc), [W|Acc]);
+ case CallF =:= ContrF of
+ true ->
+ NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
+ W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg},
+ Filter =
+ fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false;
+ (_) -> true
+ end,
+ FilterWAcc = lists:filter(Filter, WAcc),
+ postprocess_dataflow_warns(Rest, State, FilterWAcc, [W|Acc]);
+ false ->
+ postprocess_dataflow_warns(Rest, State, WAcc, Acc)
+ end;
postprocess_dataflow_warns([W|Rest], State, Wacc, Acc) ->
postprocess_dataflow_warns(Rest, State, Wacc, [W|Acc]).
diff --git a/lib/dialyzer/test/small_tests_SUITE.erl b/lib/dialyzer/test/small_tests_SUITE.erl
index 21a2c76160..dbcc044eea 100644
--- a/lib/dialyzer/test/small_tests_SUITE.erl
+++ b/lib/dialyzer/test/small_tests_SUITE.erl
@@ -18,18 +18,18 @@
contract5/1, disj_norm_form/1, eqeq/1, ets_select/1,
exhaust_case/1, failing_guard1/1, flatten/1, fun_app/1,
fun_ref_match/1, fun_ref_record/1, gencall/1, gs_make/1,
- inf_loop2/1, letrec1/1, list_match/1, lzip/1, make_tuple/1,
- minus_minus/1, mod_info/1, my_filter/1, my_sofs/1, no_match/1,
- no_unused_fun/1, no_unused_fun2/1, non_existing/1,
- not_guard_crash/1, or_bug/1, orelsebug/1, orelsebug2/1,
- overloaded1/1, port_info_test/1, process_info_test/1, pubsub/1,
- receive1/1, record_construct/1, record_pat/1,
- record_send_test/1, record_test/1, recursive_types1/1,
- recursive_types2/1, recursive_types3/1, recursive_types4/1,
- recursive_types5/1, recursive_types6/1, recursive_types7/1,
- refine_bug1/1, toth/1, trec/1, try1/1, tuple1/1,
- unsafe_beamcode_bug/1, unused_cases/1, unused_clauses/1,
- zero_tuple/1]).
+ inf_loop2/1, invalid_specs/1, letrec1/1, list_match/1, lzip/1,
+ make_tuple/1, minus_minus/1, mod_info/1, my_filter/1,
+ my_sofs/1, no_match/1, no_unused_fun/1, no_unused_fun2/1,
+ non_existing/1, not_guard_crash/1, or_bug/1, orelsebug/1,
+ orelsebug2/1, overloaded1/1, port_info_test/1,
+ process_info_test/1, pubsub/1, receive1/1, record_construct/1,
+ record_pat/1, record_send_test/1, record_test/1,
+ recursive_types1/1, recursive_types2/1, recursive_types3/1,
+ recursive_types4/1, recursive_types5/1, recursive_types6/1,
+ recursive_types7/1, refine_bug1/1, toth/1, trec/1, try1/1,
+ tuple1/1, unsafe_beamcode_bug/1, unused_cases/1,
+ unused_clauses/1, zero_tuple/1]).
suite() ->
[{timetrap, {minutes, 1}}].
@@ -51,10 +51,10 @@ all() ->
atom_guard,atom_widen,bs_fail_constr,bs_utf8,cerl_hipeify,comm_layer,
compare1,confusing_warning,contract2,contract3,contract5,disj_norm_form,
eqeq,ets_select,exhaust_case,failing_guard1,flatten,fun_app,fun_ref_match,
- fun_ref_record,gencall,gs_make,inf_loop2,letrec1,list_match,lzip,
- make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,no_unused_fun,
- no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,orelsebug2,
- overloaded1,port_info_test,process_info_test,pubsub,receive1,
+ fun_ref_record,gencall,gs_make,inf_loop2,invalid_specs,letrec1,list_match,
+ lzip,make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,
+ no_unused_fun,no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,
+ orelsebug2,overloaded1,port_info_test,process_info_test,pubsub,receive1,
record_construct,record_pat,record_send_test,record_test,recursive_types1,
recursive_types2,recursive_types3,recursive_types4,recursive_types5,
recursive_types6,recursive_types7,refine_bug1,toth,trec,try1,tuple1,
@@ -235,6 +235,12 @@ inf_loop2(Config) ->
Error -> ct:fail(Error)
end.
+invalid_specs(Config) ->
+ case dialyze(Config, invalid_specs) of
+ 'same' -> 'same';
+ Error -> ct:fail(Error)
+ end.
+
letrec1(Config) ->
case dialyze(Config, letrec1) of
'same' -> 'same';
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs
new file mode 100644
index 0000000000..c95c0ff1f8
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs
@@ -0,0 +1,3 @@
+
+invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]}
+invalid_spec2.erl:5: Function foo/0 has no local return
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl
new file mode 100644
index 0000000000..06ab2f9a22
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl
@@ -0,0 +1,28 @@
+-module(invalid_spec1).
+
+-export([get_plan_dirty/1]).
+
+-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}.
+
+get_plan_dirty(ClassL) ->
+ get_plan_dirty(ClassL, [], []).
+
+get_plan_dirty([], Res, FoundClassList) ->
+ {Res,FoundClassList};
+get_plan_dirty([Class|ClassL], Res, FoundClassList) ->
+ ClassPlan = list_to_atom(Class ++ "_plan"),
+ case catch mnesia:dirty_all_keys(ClassPlan) of
+ {'EXIT',_} ->
+ get_plan_dirty(ClassL, Res, FoundClassList);
+ [] ->
+ get_plan_dirty(ClassL, Res, FoundClassList);
+ KeyL ->
+ ClassAtom = list_to_atom(Class),
+ Res2 =
+ lists:foldl(fun(Key, Acc) ->
+ [{ClassAtom,Key}|Acc]
+ end,
+ Res,
+ KeyL),
+ get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList])
+ end.
diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl
new file mode 100644
index 0000000000..e49f73d014
--- /dev/null
+++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl
@@ -0,0 +1,11 @@
+-module(invalid_spec2).
+
+-export([foo/0]).
+
+foo() ->
+ case
+ invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo))
+ of
+ {[],[]} -> foo;
+ { _, _} -> bar
+ end.
diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c
index d9560eebc8..146a106e7c 100644
--- a/lib/erl_interface/src/legacy/erl_timeout.c
+++ b/lib/erl_interface/src/legacy/erl_timeout.c
@@ -43,6 +43,7 @@
# endif
#endif
+#include "erl_interface.h"
#include "erl_timeout.h"
typedef struct jmp_s {
diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl
index 4751f1094a..45d2387e7b 100644
--- a/lib/eunit/src/eunit_lib.erl
+++ b/lib/eunit/src/eunit_lib.erl
@@ -33,7 +33,7 @@
-export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1,
command/2, command/3, trie_new/0, trie_store/2, trie_match/2,
split_node/1, consult_file/1, list_dir/1, format_exit_term/1,
- format_exception/1, format_error/1]).
+ format_exception/1, format_exception/2, format_error/1]).
%% Type definitions for describing exceptions
@@ -55,21 +55,23 @@
%% ---------------------------------------------------------------------
%% Formatting of error descriptors
+format_exception(Exception) ->
+ format_exception(Exception, 20).
-format_exception({Class,Term,Trace})
+format_exception({Class,Term,Trace}, Depth)
when is_atom(Class), is_list(Trace) ->
case is_stacktrace(Trace) of
true ->
io_lib:format("~w:~P\n~s",
- [Class, Term, 20, format_stacktrace(Trace)]);
+ [Class, Term, Depth, format_stacktrace(Trace)]);
false ->
- format_term(Term)
+ format_term(Term, Depth)
end;
-format_exception(Term) ->
- format_term(Term).
+format_exception(Term, Depth) ->
+ format_term(Term, Depth).
-format_term(Term) ->
- io_lib:format("~P\n", [Term, 15]).
+format_term(Term, Depth) ->
+ io_lib:format("~P\n", [Term, Depth]).
format_exit_term(Term) ->
{Reason, Trace} = analyze_exit_term(Term),
diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl
index eb994a990a..f289cd724a 100644
--- a/lib/eunit/src/eunit_surefire.erl
+++ b/lib/eunit/src/eunit_surefire.erl
@@ -323,7 +323,7 @@ write_testcase(
format_testcase_result(ok) -> [<<>>];
format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) ->
[?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE,
- <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)),
?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
format_testcase_result({failed, Term}) ->
[?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE,
@@ -331,7 +331,7 @@ format_testcase_result({failed, Term}) ->
?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE];
format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) ->
[?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE,
- <<"::">>, escape_text(eunit_lib:format_exception(Exception)),
+ <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)),
?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE];
format_testcase_result({aborted, Term}) ->
[?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE,
diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
index de0f23bf24..93563c6011 100644
--- a/lib/kernel/src/inet_res.erl
+++ b/lib/kernel/src/inet_res.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -539,27 +539,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer)
when ?ip(A,B,C,D), ?port(Port) ->
gen_udp:send(I, IP, Port, Buffer).
-udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout)
+udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode)
when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) ->
- do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout);
-udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout)
+ do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout);
+udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode)
when ?ip(A,B,C,D), ?port(Port) ->
- do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout).
-
-do_udp_recv(Recv, IP, Port, Timeout) ->
- do_udp_recv(Recv, IP, Port, Timeout,
- if Timeout =/= 0 -> erlang:now(); true -> undefined end).
-
-do_udp_recv(Recv, IP, Port, Timeout, Then) ->
- case Recv(Timeout) of
- {ok,{IP,Port,Answer}} ->
- {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))};
- {ok,_} when Timeout =:= 0 ->
- {error,timeout};
- {ok,_} ->
- Now = erlang:now(),
- T = erlang:max(0, Timeout - now_ms(Now, Then)),
- do_udp_recv(Recv, IP, Port, T, Now);
+ do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout).
+
+do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) ->
+ timeout;
+do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) ->
+ case gen_udp:recv(I, 0, T) of
+ {ok,Reply} ->
+ case Decode(Reply) of
+ false when T =:= 0 ->
+ %% This is a compromize between the hard way i.e
+ %% in the clause below if NewT becomes 0 bailout
+ %% immediately and risk that the right reply lies
+ %% ahead after some bad id replies, and the
+ %% forgiving way i.e go on with Timeout 0 until
+ %% the right reply comes or no reply (timeout)
+ %% which opens for a DOS attack by a malicious
+ %% DNS server flooding with bad id replies causing
+ %% an infinite loop here.
+ %%
+ %% Timeout is used as a sanity limit counter
+ %% just to put an end to the loop.
+ NewTimeout = erlang:max(0, Timeout - 50),
+ do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T);
+ false ->
+ Now = erlang:now(),
+ NewT = erlang:max(0, Timeout - now_ms(Now, Start)),
+ do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT);
+ Result ->
+ Result
+ end;
Error -> Error
end.
@@ -580,6 +594,17 @@ udp_close(#sock{inet=I,inet6=I6}) ->
%% end
%% end
%%
+%% But that man page also says dig always use num_servers = 1.
+%%
+%% Our man page says: timeout/retry, then double for next retry, i.e
+%% for i = 0 to retry - 1
+%% foreach nameserver
+%% send query
+%% wait((time * (2**i)) / retry)
+%% end
+%% end
+%%
+%% And that is what the code seems to do, now fixed, hopefully...
do_query(_Q, [], _Timer) ->
{error,nxdomain};
@@ -589,19 +614,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) ->
query_retries(_Q, _NSs, _Timer, Retry, Retry, S) ->
udp_close(S),
{error,timeout};
+query_retries(_Q, [], _Timer, _Retry, _I, S) ->
+ udp_close(S),
+ {error,timeout};
query_retries(Q, NSs, Timer, Retry, I, S0) ->
- Num = length(NSs),
- if Num =:= 0 ->
- udp_close(S0),
- {error,timeout};
- true ->
- case query_nss(Q, NSs, Timer, Retry, I, S0, []) of
- {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers
- query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S);
- {S,Result} ->
- udp_close(S),
- Result
- end
+ case query_nss(Q, NSs, Timer, Retry, I, S0, []) of
+ {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers
+ query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S);
+ {S,Result} ->
+ udp_close(S),
+ Result
end.
query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) ->
@@ -611,13 +633,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) ->
query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) ->
query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs).
-query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options,
- edns={Id,Buffer}}=Q,
- [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) ->
- {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
- Retry, I, Options, PSz),
+query_nss_edns(
+ #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q,
+ [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) ->
+ {S,Res}=Reply =
+ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz),
case Res of
- timeout -> {S,{error,timeout}};
+ timeout -> {S,{error,timeout}}; % Bailout timeout
{ok,_} -> Reply;
{error,{nxdomain,_}} -> Reply;
{error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail;
@@ -629,17 +651,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options,
query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs)
end.
-query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs],
- Timer, Retry, I, S0, ErrNSs) ->
+query_nss_dns(
+ #q{dns=Qdns}=Q0,
+ [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) ->
#q{options=Options,dns={Id,Buffer}}=Q =
if
is_function(Qdns, 0) -> Q0#q{dns=Qdns()};
true -> Q0
end,
- {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer,
- Retry, I, Options, ?PACKETSZ),
+ {S,Res}=Reply =
+ query_ns(
+ S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ),
case Res of
- timeout -> {S,{error,timeout}};
+ timeout -> {S,{error,timeout}}; % Bailout timeout
{ok,_} -> Reply;
{error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply;
{error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused ->
@@ -653,48 +677,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I,
PSz) ->
case UseVC orelse iolist_size(Buffer) > PSz of
true ->
- {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)};
+ TcpTimeout = inet:timeout(Tm*5, Timer),
+ {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)};
false ->
case udp_open(S0, IP) of
{ok,S} ->
- {S,case query_udp(S, Id, Buffer, IP, Port, Timer,
- Retry, I, Tm, Verbose) of
- {ok,#dns_rec{header=H}} when H#dns_header.tc ->
- query_tcp(Tm, Id, Buffer,
- IP, Port, Timer, Verbose);
- Reply -> Reply
- end};
+ Timeout =
+ inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
+ {S,
+ case query_udp(
+ S, Id, Buffer, IP, Port, Timeout, Verbose) of
+ {ok,#dns_rec{header=H}} when H#dns_header.tc ->
+ TcpTimeout = inet:timeout(Tm*5, Timer),
+ query_tcp(
+ TcpTimeout, Id, Buffer, IP, Port, Verbose);
+ Reply -> Reply
+ end};
Error ->
{S0,Error}
end
end.
-query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) ->
- Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer),
+query_udp(_S, _Id, _Buffer, _IP, _Port, 0, Verbose) ->
+ timeout;
+query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) ->
?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n",
- [IP, Port, Timeout]),
- udp_connect(S, IP, Port),
- udp_send(S, IP, Port, Buffer),
- query_udp_recv(S, IP, Port, Id, Timeout, Verbose).
-
-query_udp_recv(S, IP, Port, Id, Timeout, Verbose) ->
- case udp_recv(S, IP, Port, Timeout) of
- {ok,Answer,T} ->
- case decode_answer(Answer, Id, Verbose) of
- {error, badid} ->
- query_udp_recv(S, IP, Port, Id, T, Verbose);
- Reply -> Reply
+ [IP,Port,Timeout]),
+ case
+ case udp_connect(S, IP, Port) of
+ ok ->
+ udp_send(S, IP, Port, Buffer);
+ E1 ->
+ E1 end of
+ ok ->
+ Decode =
+ fun ({RecIP,RecPort,Answer})
+ when RecIP =:= IP, RecPort =:= Port ->
+ case decode_answer(Answer, Id, Verbose) of
+ {error,badid} ->
+ false;
+ Reply ->
+ Reply
+ end;
+ ({_,_,_}) ->
+ false
+ end,
+ case udp_recv(S, IP, Port, Timeout, Decode) of
+ {ok,_}=Result ->
+ Result;
+ E2 ->
+ ?verbose(Verbose, "UDP server error: ~p\n", [E2]),
+ E2
end;
- {error, timeout} when Timeout =:= 0 ->
- ?verbose(Verbose, "UDP server timeout\n", []),
- timeout;
- Error ->
- ?verbose(Verbose, "UDP server error: ~p\n", [Error]),
- Error
+ E3 ->
+ ?verbose(Verbose, "UDP send failed: ~p\n", [E3]),
+ {error,econnrefused}
end.
-query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) ->
- Timeout = inet:timeout(Tm*5, Timer),
+query_tcp(0, _Id, _Buffer, _IP, _Port, Verbose) ->
+ timeout;
+query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) ->
?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n",
[IP, Port, Timeout]),
Family = case IP of
@@ -716,19 +758,10 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) ->
end;
Error ->
gen_tcp:close(S),
- case Error of
- {error, timeout} when Timeout =:= 0 ->
- ?verbose(Verbose, "TCP server recv timeout\n", []),
- timeout;
- _ ->
- ?verbose(Verbose, "TCP server recv error: ~p\n",
- [Error]),
- Error
- end
+ ?verbose(Verbose, "TCP server recv error: ~p\n",
+ [Error]),
+ Error
end;
- {error, timeout} when Timeout =:= 0 ->
- ?verbose(Verbose, "TCP server connect timeout\n", []),
- timeout;
Error ->
?verbose(Verbose, "TCP server error: ~p\n", [Error]),
Error
diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl
index 49a02359b0..5228d4fe01 100644
--- a/lib/kernel/src/net_kernel.erl
+++ b/lib/kernel/src/net_kernel.erl
@@ -1249,7 +1249,7 @@ protocol_childspecs([H|T]) ->
epmd_module() ->
case init:get_argument(epmd_module) of
{ok,[[Module]]} ->
- Module;
+ list_to_atom(Module);
_ ->
erl_epmd
end.
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index 8078c7d021..2f73394c4e 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -2055,6 +2055,10 @@ try_read_file_list(Fd) ->
?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n",
?line Title = io:get_line(Fd, ''),
+ %% Seek past the end of the file.
+
+ ?line {ok, _} = ?FILE_MODULE:position(Fd, 25000),
+
%% Done.
?line ?FILE_MODULE:close(Fd),
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 043c753cf8..233e438dc9 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2, start/1, restart/1,
- reboot/1, set_cmd/1, clear_cmd/1,
+ reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1,
dont_drop/1, kill_pid/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -58,7 +58,7 @@ end_per_testcase(_Func, Config) ->
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [start, restart, reboot, set_cmd, clear_cmd, kill_pid].
+ [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid].
groups() ->
[].
@@ -246,6 +246,15 @@ clear_cmd(Config) when is_list(Config) ->
end,
ok.
+get_cmd(suite) -> [];
+get_cmd(Config) when is_list(Config) ->
+ ?line {ok, Node} = start_check(slave, heart_test),
+ Cmd = "test",
+ ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]),
+ ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []),
+ stop_node(Node),
+ ok.
+
dont_drop(suite) ->
%%% Removed as it may crash epmd/distribution in colourful
%%% ways. While we ARE finding out WHY, it would
diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl
index 5fc8df475d..6064a9b2d9 100644
--- a/lib/kernel/test/inet_res_SUITE.erl
+++ b/lib/kernel/test/inet_res_SUITE.erl
@@ -27,7 +27,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2, end_per_testcase/2]).
--export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]).
+-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1,
+ last_ms_answer/1]).
-export([
gethostbyaddr/0, gethostbyaddr/1,
gethostbyaddr_v6/0, gethostbyaddr_v6/1,
@@ -45,6 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[basic, resolve, edns0, txt_record, files_monitor,
+ last_ms_answer,
gethostbyaddr, gethostbyaddr_v6, gethostbyname,
gethostbyname_v6, getaddr, getaddr_v6, ipv4_to_ipv6,
host_and_addr].
@@ -64,16 +66,15 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-zone_dir(basic) ->
- otptest;
-zone_dir(resolve) ->
- otptest;
-zone_dir(edns0) ->
- otptest;
-zone_dir(files_monitor) ->
- otptest;
-zone_dir(_) ->
- undefined.
+zone_dir(TC) ->
+ case TC of
+ basic -> otptest;
+ resolve -> otptest;
+ edns0 -> otptest;
+ files_monitor -> otptest;
+ last_ms_answer -> otptest;
+ _ -> undefined
+ end.
init_per_testcase(Func, Config) ->
PrivDir = ?config(priv_dir, Config),
@@ -184,6 +185,88 @@ ns_printlog(Fname) ->
ok
end.
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Behaviour modifying nameserver proxy
+
+proxy_start(TC, {NS,P}) ->
+ Tag = make_ref(),
+ Parent = self(),
+ Pid =
+ spawn_link(
+ fun () ->
+ try proxy_start(TC, NS, P, Parent, Tag)
+ catch C:X ->
+ io:format(
+ "~w: ~w:~p ~p~n",
+ [self(),C,X,erlang:get_stacktrace()])
+ end
+ end),
+ receive {started,Tag,Port} ->
+ ProxyNS = {{127,0,0,1},Port},
+ {proxy,Pid,Tag,ProxyNS}
+ end.
+
+proxy_start(TC, NS, P, Parent, Tag) ->
+ {ok,Outbound} = gen_udp:open(0, [binary]),
+ ok = gen_udp:connect(Outbound, NS, P),
+ {ok,Inbound} = gen_udp:open(0, [binary]),
+ {ok,Port} = inet:port(Inbound),
+ Parent ! {started,Tag,Port},
+ proxy(TC, Outbound, NS, P, Inbound).
+
+
+%% To provoke the last_ms_answer bug (OTP-9221) the proxy
+%% * Relays the query to the right nameserver
+%% * Intercepts the reply but holds it until the timer that
+%% was started when receiving the query fires.
+%% * Repeats the reply with incorrect query ID a number of
+%% times with a short interval.
+%% * Sends the correct reply, to give a correct test result
+%% after bug correction.
+%%
+%% The repetition of an incorrect answer with tight interval will keep
+%% inet_res in an inner loop in the code that decrements the remaining
+%% time until it hits 0 which triggers a crash, if the outer timeout
+%% parameter to inet_res:resolve is so short that it runs out during
+%% these repetitions.
+proxy(last_ms_answer, Outbound, NS, P, Inbound) ->
+ receive
+ {udp,Inbound,SrcIP,SrcPort,Data} ->
+ Time =
+ inet_db:res_option(timeout) div inet_db:res_option(retry),
+ Tag = erlang:make_ref(),
+ erlang:send_after(Time - 10, self(), {time,Tag}),
+ ok = gen_udp:send(Outbound, NS, P, Data),
+ receive
+ {udp,Outbound,NS,P,Reply} ->
+ {ok,Msg} = inet_dns:decode(Reply),
+ Hdr = inet_dns:msg(Msg, header),
+ Id = inet_dns:header(Hdr, id),
+ BadHdr =
+ inet_dns:make_header(Hdr, id, (Id+1) band 16#ffff),
+ BadMsg = inet_dns:make_msg(Msg, header, BadHdr),
+ BadReply = inet_dns:encode(BadMsg),
+ receive
+ {time,Tag} ->
+ proxy__last_ms_answer(
+ Inbound, SrcIP, SrcPort, BadReply, Reply, 30)
+ end
+ end
+ end.
+
+proxy__last_ms_answer(Socket, IP, Port, _, Reply, 0) ->
+ ok = gen_udp:send(Socket, IP, Port, Reply);
+proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N) ->
+ ok = gen_udp:send(Socket, IP, Port, BadReply),
+ receive after 1 -> ok end,
+ proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N-1).
+
+proxy_wait({proxy,Pid,_,_}) ->
+ Mref = erlang:monitor(process, Pid),
+ receive {'DOWN',Mref,_,_,_} -> ok end.
+
+proxy_ns({proxy,_,_,ProxyNS}) -> ProxyNS.
+
%%
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -204,7 +287,7 @@ basic(Config) when is_list(Config) ->
{ok,Msg1} = inet_dns:decode(Bin1),
%%
%% resolve
- {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]),
+ {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]),
io:format("~p~n", [Msg2]),
[RR2] = inet_dns:msg(Msg2, anlist),
IP = inet_dns:rr(RR2, data),
@@ -474,6 +557,26 @@ do_files_monitor(Config) ->
ok.
%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+last_ms_answer(doc) ->
+ ["Answer just when timeout is triggered (OTP-9221)"];
+last_ms_answer(Config) when is_list(Config) ->
+ NS = ns(Config),
+ Name = "ns.otptest",
+ %%IP = {127,0,0,254},
+ Time = inet_db:res_option(timeout) div inet_db:res_option(retry),
+ PSpec = proxy_start(last_ms_answer, NS),
+ ProxyNS = proxy_ns(PSpec),
+ %%
+ %% resolve; whith short timeout to trigger Timeout =:= 0 in inet_res
+ {error,timeout} =
+ inet_res:resolve(
+ Name, in, a, [{nameservers,[ProxyNS]},verbose], Time + 10),
+ %%
+ proxy_wait(PSpec),
+ ok.
+
+%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Compatibility tests. Call the inet_SUITE tests, but with
%% lookup = [file,dns] instead of [native]
diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml
index ccf70b8373..19574a1434 100644
--- a/lib/mnesia/doc/src/notes.xml
+++ b/lib/mnesia/doc/src/notes.xml
@@ -38,7 +38,35 @@
thus constitutes one section in this document. The title of each
section is the version number of Mnesia.</p>
- <section><title>Mnesia 4.4.17</title>
+ <section><title>Mnesia 4.4.18</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Call chmod without the "-f" flag</p>
+ <p>
+ "-f" is a non-standard chmod option which at least SGI
+ IRIX and HP UX do not support. As the only effect of the
+ "-f" flag is to suppress warning messages, it can be
+ safely omitted. (Thanks to Holger Wei�)</p>
+ <p>
+ Own Id: OTP-9170</p>
+ </item>
+ <item>
+ <p>
+ Mnesia sometimes failed to update meta-information in
+ large systems, which could cause table content to be
+ inconsistent between nodes.</p>
+ <p>
+ Own Id: OTP-9186 Aux Id: seq11728 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Mnesia 4.4.17</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src
index 0eff761b61..7bad6c4ea6 100644
--- a/lib/mnesia/src/mnesia.appup.src
+++ b/lib/mnesia/src/mnesia.appup.src
@@ -1,25 +1,33 @@
%% -*- erlang -*-
{"%VSN%",
[
- {"4.4.16",[
- {update, mnesia_frag, soft, soft_purge, soft_purge, []},
- {update, mnesia_schema, soft, soft_purge, soft_purge, []}
+ {"4.4.17",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []}
]},
- {"4.4.15",[
- {update, mnesia_frag, soft, soft_purge, soft_purge, []},
- {update, mnesia, soft, soft_purge, soft_purge, []},
- {update, mnesia_dumper, soft, soft_purge, soft_purge, []}
- ]}
- ],
- [
{"4.4.16",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
{update, mnesia_frag, soft, soft_purge, soft_purge, []},
{update, mnesia_schema, soft, soft_purge, soft_purge, []}
]},
{"4.4.15",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
{update, mnesia_frag, soft, soft_purge, soft_purge, []},
{update, mnesia, soft, soft_purge, soft_purge, []},
{update, mnesia_dumper, soft, soft_purge, soft_purge, []}
]}
- ]
+ ],
+ {"4.4.17",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []}
+ ]},
+ {"4.4.16",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
+ {update, mnesia_frag, soft, soft_purge, soft_purge, []},
+ {update, mnesia_schema, soft, soft_purge, soft_purge, []}
+ ]},
+ {"4.4.15",[
+ {update, mnesia_controller, soft, soft_purge, soft_purge, []},
+ {update, mnesia_frag, soft, soft_purge, soft_purge, []},
+ {update, mnesia, soft, soft_purge, soft_purge, []},
+ {update, mnesia_dumper, soft, soft_purge, soft_purge, []}
+ ]}
}.
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 021be8af2a..0254769758 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -457,7 +457,7 @@ connect_nodes2(Father, Ns, UserFun) ->
New1 = mnesia_lib:intersect(Ns, Connected),
New = New1 -- Current,
process_flag(trap_exit, true),
- Res = try_merge_schema(New, UserFun),
+ Res = try_merge_schema(New, [], UserFun),
Msg = {schema_is_merged, [], late_merge, []},
multicall([node()|Ns], Msg),
After = val({current, db_nodes}),
@@ -471,7 +471,7 @@ connect_nodes2(Father, Ns, UserFun) ->
merge_schema() ->
AllNodes = mnesia_lib:all_nodes(),
- case try_merge_schema(AllNodes, fun default_merge/1) of
+ case try_merge_schema(AllNodes, [node()], fun default_merge/1) of
ok ->
schema_is_merged();
{aborted, {throw, Str}} when is_list(Str) ->
@@ -483,11 +483,17 @@ merge_schema() ->
default_merge(F) ->
F([]).
-try_merge_schema(Nodes, UserFun) ->
+try_merge_schema(Nodes, Told0, UserFun) ->
case mnesia_schema:merge_schema(UserFun) of
{atomic, not_merged} ->
%% No more nodes that we need to merge the schema with
- ok;
+ %% Ensure we have told everybody that we are running
+ case val({current,db_nodes}) -- mnesia_lib:uniq(Told0) of
+ [] -> ok;
+ Tell ->
+ im_running(Tell, [node()]),
+ ok
+ end;
{atomic, {merged, OldFriends, NewFriends}} ->
%% Check if new nodes has been added to the schema
Diff = mnesia_lib:all_nodes() -- [node() | Nodes],
@@ -496,12 +502,18 @@ try_merge_schema(Nodes, UserFun) ->
%% Tell everybody to adopt orphan tables
im_running(OldFriends, NewFriends),
im_running(NewFriends, OldFriends),
-
- try_merge_schema(Nodes, UserFun);
+ Told = case lists:member(node(), NewFriends) of
+ true -> Told0 ++ OldFriends;
+ false -> Told0 ++ NewFriends
+ end,
+ try_merge_schema(Nodes, Told, UserFun);
{atomic, {"Cannot get cstructs", Node, Reason}} ->
dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]),
- timer:sleep(1000), % Avoid a endless loop look alike
- try_merge_schema(Nodes, UserFun);
+ timer:sleep(300), % Avoid a endless loop look alike
+ try_merge_schema(Nodes, Told0, UserFun);
+ {aborted, {shutdown, _}} -> %% One of the nodes is going down
+ timer:sleep(300), % Avoid a endless loop look alike
+ try_merge_schema(Nodes, Told0, UserFun);
Other ->
Other
end.
@@ -915,6 +927,7 @@ handle_cast(unblock_controller, State) ->
handle_cast({mnesia_down, Node}, State) ->
maybe_log_mnesia_down(Node),
mnesia_lib:del({current, db_nodes}, Node),
+ mnesia_lib:unset({node_up, Node}),
mnesia_checkpoint:tm_mnesia_down(Node),
Alltabs = val({schema, tables}),
reconfigure_tables(Node, Alltabs),
@@ -977,11 +990,12 @@ handle_cast(Msg, State) when State#state.schema_is_merged /= true ->
%% This must be done after schema_is_merged otherwise adopt_orphan
%% might trigger a table load from wrong nodes as a result of that we don't
%% know which tables we can load safly first.
-handle_cast({im_running, _Node, NewFriends}, State) ->
+handle_cast({im_running, Node, NewFriends}, State) ->
LocalTabs = mnesia_lib:local_active_tables() -- [schema],
RemoveLocalOnly = fun(Tab) -> not val({Tab, local_content}) end,
Tabs = lists:filter(RemoveLocalOnly, LocalTabs),
- Ns = mnesia_lib:intersect(NewFriends, val({current, db_nodes})),
+ Nodes = mnesia_lib:union([Node],val({current, db_nodes})),
+ Ns = mnesia_lib:intersect(NewFriends, Nodes),
abcast(Ns, {adopt_orphans, node(), Tabs}),
noreply(State);
@@ -1042,30 +1056,33 @@ handle_cast({master_nodes_updated, Tab, Masters}, State) ->
end;
handle_cast({adopt_orphans, Node, Tabs}, State) ->
-
State2 = node_has_tabs(Tabs, Node, State),
- %% Register the other node as up and running
- mnesia_recover:log_mnesia_up(Node),
- verbose("Logging mnesia_up ~w~n",[Node]),
- mnesia_lib:report_system_event({mnesia_up, Node}),
-
- %% Load orphan tables
- LocalTabs = val({schema, local_tables}) -- [schema],
- Nodes = val({current, db_nodes}),
- {LocalOrphans, RemoteMasters} =
- orphan_tables(LocalTabs, Node, Nodes, [], []),
- Reason = {adopt_orphan, node()},
- mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason),
-
- Fun =
- fun(N) ->
- RemoteOrphans =
- [Tab || {Tab, Ns} <- RemoteMasters,
- lists:member(N, Ns)],
- mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason)
- end,
- lists:foreach(Fun, Nodes),
+ case ?catch_val({node_up,Node}) of
+ true -> ignore;
+ _ ->
+ %% Register the other node as up and running
+ set({node_up, Node}, true),
+ mnesia_recover:log_mnesia_up(Node),
+ verbose("Logging mnesia_up ~w~n",[Node]),
+ mnesia_lib:report_system_event({mnesia_up, Node}),
+ %% Load orphan tables
+ LocalTabs = val({schema, local_tables}) -- [schema],
+ Nodes = val({current, db_nodes}),
+ {LocalOrphans, RemoteMasters} =
+ orphan_tables(LocalTabs, Node, Nodes, [], []),
+ Reason = {adopt_orphan, node()},
+ mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason),
+
+ Fun =
+ fun(N) ->
+ RemoteOrphans =
+ [Tab || {Tab, Ns} <- RemoteMasters,
+ lists:member(N, Ns)],
+ mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason)
+ end,
+ lists:foreach(Fun, Nodes)
+ end,
noreply(State2);
handle_cast(Msg, State) ->
diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk
index 5247657b68..38e1a94545 100644
--- a/lib/mnesia/vsn.mk
+++ b/lib/mnesia/vsn.mk
@@ -1 +1 @@
-MNESIA_VSN = 4.4.17
+MNESIA_VSN = 4.4.18
diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl
index 3340f7ee72..3ee1df759f 100644
--- a/lib/os_mon/src/disksup.erl
+++ b/lib/os_mon/src/disksup.erl
@@ -103,6 +103,7 @@ init([]) ->
Flavor==darwin;
Flavor==linux;
Flavor==openbsd;
+ Flavor==netbsd;
Flavor==irix64;
Flavor==irix ->
start_portprogram();
@@ -267,6 +268,9 @@ check_disk_space({unix, freebsd}, Port, Threshold) ->
check_disk_space({unix, openbsd}, Port, Threshold) ->
Result = my_cmd("/bin/df -k -t ffs", Port),
check_disks_solaris(skip_to_eol(Result), Threshold);
+check_disk_space({unix, netbsd}, Port, Threshold) ->
+ Result = my_cmd("/bin/df -k -t ffs", Port),
+ check_disks_solaris(skip_to_eol(Result), Threshold);
check_disk_space({unix, sunos4}, Port, Threshold) ->
Result = my_cmd("df", Port),
check_disks_solaris(skip_to_eol(Result), Threshold);
diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl
index 822e1f939c..cc4941ee7d 100644
--- a/lib/os_mon/src/memsup.erl
+++ b/lib/os_mon/src/memsup.erl
@@ -176,9 +176,11 @@ init([]) ->
PortMode = case OS of
{unix, darwin} -> false;
{unix, freebsd} -> false;
+ {unix, dragonfly} -> false;
% Linux supports this.
{unix, linux} -> true;
{unix, openbsd} -> true;
+ {unix, netbsd} -> true;
{unix, irix64} -> true;
{unix, irix} -> true;
{unix, sunos} -> true;
@@ -610,8 +612,10 @@ code_change(Vsn, PrevState, "1.8") ->
PortMode = case OS of
{unix, darwin} -> false;
{unix, freebsd} -> false;
+ {unix, dragonfly} -> false;
{unix, linux} -> false;
{unix, openbsd} -> true;
+ {unix, netbsd} -> true;
{unix, sunos} -> true;
{win32, _OSname} -> false;
vxworks -> true
@@ -687,6 +691,7 @@ get_os_wordsize({unix, linux}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, darwin}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, netbsd}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, freebsd}) -> get_os_wordsize_with_uname();
+get_os_wordsize({unix, dragonfly}) -> get_os_wordsize_with_uname();
get_os_wordsize({unix, openbsd}) -> get_os_wordsize_with_uname();
get_os_wordsize(_) -> unsupported_os.
@@ -736,7 +741,7 @@ get_memory_usage({unix,darwin}) ->
%% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct
%% vmmeter
-get_memory_usage({unix,freebsd}) ->
+get_memory_usage({unix,OSname}) when OSname == freebsd; OSname == dragonfly ->
PageSize = freebsd_sysctl("vm.stats.vm.v_page_size"),
PageCount = freebsd_sysctl("vm.stats.vm.v_page_count"),
FreeCount = freebsd_sysctl("vm.stats.vm.v_free_count"),
@@ -779,6 +784,9 @@ get_ext_memory_usage(OS, {Alloc, Total}) ->
{unix, freebsd} ->
[{total_memory, Total}, {free_memory, Total-Alloc},
{system_total_memory, Total}];
+ {unix, dragonfly} ->
+ [{total_memory, Total}, {free_memory, Total-Alloc},
+ {system_total_memory, Total}];
{unix, darwin} ->
[{total_memory, Total}, {free_memory, Total-Alloc},
{system_total_memory, Total}];
diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src
index c65ac7bc99..4986801dad 100644
--- a/lib/public_key/src/public_key.appup.src
+++ b/lib/public_key/src/public_key.appup.src
@@ -1,6 +1,16 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {"0.11",
+ [
+ {update, public_key, soft, soft_purge, soft_purge, []},
+ {update, pubkey_pem, soft, soft_purge, soft_purge, []},
+ {add_module, pubkey_ssh, soft, soft_purge, soft_purge},
+ {update, pubkey_cert, soft, soft_purge, soft_purge, []},
+ {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}
+ ]
+ },
+
{"0.10",
[
{update, public_key, soft, soft_purge, soft_purge, []},
@@ -25,6 +35,16 @@
}
],
[
+ {"0.11",
+ [
+ {update, public_key, soft, soft_purge, soft_purge, []},
+ {update, pubkey_pem, soft, soft_purge, soft_purge, []},
+ {delete_module, pubkey_ssh, soft, soft_purge, soft_purge},
+ {update, pubkey_cert, soft, soft_purge, soft_purge, []},
+ {update, pubkey_cert_records, soft, soft_purge, soft_purge, []}
+ ]
+ },
+
{"0.10",
[
{update, public_key, soft, soft_purge, soft_purge, []},
diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl
index 660af4e8ab..a325a975e9 100644
--- a/lib/public_key/test/pkits_SUITE.erl
+++ b/lib/public_key/test/pkits_SUITE.erl
@@ -26,7 +26,6 @@
-compile(export_all).
-include_lib("public_key/include/public_key.hrl").
-%%-include("public_key.hrl").
-define(error(Format,Args), error(Format,Args,?FILE,?LINE)).
-define(warning(Format,Args), warning(Format,Args,?FILE,?LINE)).
@@ -42,18 +41,65 @@
-define(NIST5, "2.16.840.1.101.3.2.1.48.5").
-define(NIST6, "2.16.840.1.101.3.2.1.48.6").
+-record(verify_state, {
+ certs_db,
+ crl_info,
+ revoke_state}).
%%
-suite() -> [{ct_hooks,[ts_install_cth]}].
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
all() ->
- [signature_verification, validity_periods,
- verifying_name_chaining,
- verifying_paths_with_self_issued_certificates,
- verifying_basic_constraints, key_usage,
- name_constraints, private_certificate_extensions].
+ [{group, signature_verification},
+ {group, validity_periods},
+ {group, verifying_name_chaining},
+ {group, verifying_paths_with_self_issued_certificates},
+ %%{group, basic_certificate_revocation_tests},
+ %%{group, delta_crls},
+ %%{group, distribution_points},
+ {group, verifying_basic_constraints},
+ {group, key_usage},
+ {group, name_constraints},
+ {group, private_certificate_extensions}].
groups() ->
- [].
+ [{signature_verification, [], [valid_rsa_signature,
+ invalid_rsa_signature, valid_dsa_signature,
+ invalid_dsa_signature]},
+ {validity_periods, [],
+ [not_before_invalid, not_before_valid, not_after_invalid, not_after_valid]},
+ {verifying_name_chaining, [],
+ [invalid_name_chain, whitespace_name_chain, capitalization_name_chain,
+ uid_name_chain, attrib_name_chain, string_name_chain]},
+ {verifying_paths_with_self_issued_certificates, [],
+ [basic_valid, basic_invalid, crl_signing_valid, crl_signing_invalid]},
+ %% {basic_certificate_revocation_tests, [],
+ %% [missing_CRL, revoked_CA, revoked_peer, invalid_CRL_signature,
+ %% invalid_CRL_issuer, invalid_CRL, valid_CRL,
+ %% unknown_CRL_extension, old_CRL, fresh_CRL, valid_serial,
+ %% invalid_serial, valid_seperate_keys, invalid_separate_keys]},
+ %% {delta_crls, [], [delta_without_crl, valid_delta_crls, invalid_delta_crls]},
+ %% {distribution_points, [], [valid_distribution_points,
+ %% valid_distribution_points_no_issuing_distribution_point,
+ %% invalid_distribution_points, valid_only_contains,
+ %% invalid_only_contains, valid_only_some_reasons,
+ %% invalid_only_some_reasons, valid_indirect_crl,
+ %% invalid_indirect_crl, valid_crl_issuer, invalid_crl_issuer]},
+ {verifying_basic_constraints,[],
+ [missing_basic_constraints, valid_basic_constraint, invalid_path_constraints,
+ valid_path_constraints]},
+ {key_usage, [],
+ [invalid_key_usage, valid_key_usage]},
+ {name_constraints, [],
+ [valid_DN_name_constraints, invalid_DN_name_constraints,
+ valid_rfc822_name_constraints,
+ invalid_rfc822_name_constraints, valid_DN_and_rfc822_name_constraints,
+ invalid_DN_and_rfc822_name_constraints, valid_dns_name_constraints,
+ invalid_dns_name_constraints, valid_uri_name_constraints,
+ invalid_uri_name_constraints]},
+ {private_certificate_extensions, [],
+ [unknown_critical_extension, unknown_not_critical_extension]}
+ ].
init_per_group(_GroupName, Config) ->
Config.
@@ -61,112 +107,706 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_testcase(_Func, Config) ->
+ Datadir = proplists:get_value(data_dir, Config),
+ put(datadir, Datadir),
+ Config.
+
+end_per_testcase(_Func, Config) ->
+ Config.
+
+init_per_suite(Config) ->
+ {skip, "PKIX Conformance test certificates expired 14 of April 2011,"
+ " new conformance test suite uses new format so skip until PKCS-12 support is implemented"}.
+ %% try crypto:start() of
+ %% ok ->
+ %% Config
+ %% catch _:_ ->
+ %% {skip, "Crypto did not start"}
+ %% end.
+
+end_per_suite(_Config) ->
+ application:stop(crypto).
+
+%%-----------------------------------------------------------------------------
+valid_rsa_signature(doc) ->
+ ["Test rsa signatur verification"];
+valid_rsa_signature(suite) ->
+ [];
+valid_rsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.1", "Valid Signatures Test1", ok}]).
+
+invalid_rsa_signature(doc) ->
+ ["Test rsa signatur verification"];
+invalid_rsa_signature(suite) ->
+ [];
+invalid_rsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}},
+ { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}]).
+
+valid_dsa_signature(doc) ->
+ ["Test dsa signatur verification"];
+valid_dsa_signature(suite) ->
+ [];
+valid_dsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.4", "Valid DSA Signatures Test4", ok},
+ { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}]).
+
+invalid_dsa_signature(doc) ->
+ ["Test dsa signatur verification"];
+invalid_dsa_signature(suite) ->
+ [];
+invalid_dsa_signature(Config) when is_list(Config) ->
+ run([{ "4.1.6", "Invalid DSA Signature Test6",{bad_cert,invalid_signature}}]).
+%%-----------------------------------------------------------------------------
+not_before_invalid(doc) ->
+ [""];
+not_before_invalid(suite) ->
+ [];
+not_before_invalid(Config) when is_list(Config) ->
+ run([{ "4.2.1", "Invalid CA notBefore Date Test1",{bad_cert, cert_expired}},
+ { "4.2.2", "Invalid EE notBefore Date Test2",{bad_cert, cert_expired}}]).
+
+not_before_valid(doc) ->
+ [""];
+not_before_valid(suite) ->
+ [];
+not_before_valid(Config) when is_list(Config) ->
+ run([{ "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok},
+ { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}]).
+
+not_after_invalid(doc) ->
+ [""];
+not_after_invalid(suite) ->
+ [];
+not_after_invalid(Config) when is_list(Config) ->
+ run([{ "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}},
+ { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}},
+ { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7",{bad_cert, cert_expired}}]).
+
+not_after_valid(doc) ->
+ [""];
+not_after_valid(suite) ->
+ [];
+not_after_valid(Config) when is_list(Config) ->
+ run([{ "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]).
+%%-----------------------------------------------------------------------------
+invalid_name_chain(doc) ->
+ [""];
+invalid_name_chain(suite) ->
+ [];
+invalid_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}},
+ { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}]).
+
+whitespace_name_chain(doc) ->
+ [""];
+whitespace_name_chain(suite) ->
+ [];
+whitespace_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.3", "Valid Name Chaining Whitespace Test3", ok},
+ { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}]).
+
+capitalization_name_chain(doc) ->
+ [""];
+capitalization_name_chain(suite) ->
+ [];
+capitalization_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.5", "Valid Name Chaining Capitalization Test5",ok}]).
+
+uid_name_chain(doc) ->
+ [""];
+uid_name_chain(suite) ->
+ [];
+uid_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.6", "Valid Name Chaining UIDs Test6",ok}]).
+
+attrib_name_chain(doc) ->
+ [""];
+attrib_name_chain(suite) ->
+ [];
+attrib_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok},
+ { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}]).
+
+string_name_chain(doc) ->
+ [""];
+string_name_chain(suite) ->
+ [];
+string_name_chain(Config) when is_list(Config) ->
+ run([{ "4.3.9", "Valid UTF8String Encoded Names Test9", ok},
+ { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok},
+ { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]).
+
+%%-----------------------------------------------------------------------------
+
+basic_valid(doc) ->
+ [""];
+basic_valid(suite) ->
+ [];
+basic_valid(Config) when is_list(Config) ->
+ run([{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok},
+ { "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok},
+ { "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok}
+ ]).
+
+basic_invalid(doc) ->
+ [""];
+basic_invalid(suite) ->
+ [];
+basic_invalid(Config) when is_list(Config) ->
+ run([{"4.5.2", "Invalid Basic Self-Issued Old With New Test2",
+ {bad_cert, {revoked, keyCompromise}}},
+ {"4.5.5", "Invalid Basic Self-Issued New With Old Test5",
+ {bad_cert, {revoked, keyCompromise}}}
+ ]).
+
+crl_signing_valid(doc) ->
+ [""];
+crl_signing_valid(suite) ->
+ [];
+crl_signing_valid(Config) when is_list(Config) ->
+ run([{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}]).
+
+crl_signing_invalid(doc) ->
+ [""];
+crl_signing_invalid(suite) ->
+ [];
+crl_signing_invalid(Config) when is_list(Config) ->
+ run([{ "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8",
+ {bad_cert, invalid_key_usage}}
+ ]).
+
+%%-----------------------------------------------------------------------------
+missing_CRL(doc) ->
+ [""];
+missing_CRL(suite) ->
+ [];
+missing_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.1", "Missing CRL Test1",{bad_cert,
+ revocation_status_undetermined}}]).
+
+revoked_CA(doc) ->
+ [""];
+revoked_CA(suite) ->
+ [];
+revoked_CA(Config) when is_list(Config) ->
+ run([{ "4.4.2", "Invalid Revoked CA Test2", {bad_cert,
+ {revoked, keyCompromise}}}]).
+
+revoked_peer(doc) ->
+ [""];
+revoked_peer(suite) ->
+ [];
+revoked_peer(Config) when is_list(Config) ->
+ run([{ "4.4.3", "Invalid Revoked EE Test3", {bad_cert,
+ {revoked, keyCompromise}}}]).
+
+invalid_CRL_signature(doc) ->
+ [""];
+invalid_CRL_signature(suite) ->
+ [];
+invalid_CRL_signature(Config) when is_list(Config) ->
+ run([{ "4.4.4", "Invalid Bad CRL Signature Test4",
+ {bad_cert, revocation_status_undetermined}}]).
+
+invalid_CRL_issuer(doc) ->
+ [""];
+invalid_CRL_issuer(suite) ->
+ [];
+invalid_CRL_issuer(Config) when is_list(Config) ->
+ run({ "4.4.5", "Invalid Bad CRL Issuer Name Test5",
+ {bad_cert, revocation_status_undetermined}}).
+
+invalid_CRL(doc) ->
+ [""];
+invalid_CRL(suite) ->
+ [];
+invalid_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.6", "Invalid Wrong CRL Test6",
+ {bad_cert, revocation_status_undetermined}}]).
+
+valid_CRL(doc) ->
+ [""];
+valid_CRL(suite) ->
+ [];
+valid_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.7", "Valid Two CRLs Test7", ok}]).
+
+unknown_CRL_extension(doc) ->
+ [""];
+unknown_CRL_extension(suite) ->
+ [];
+unknown_CRL_extension(Config) when is_list(Config) ->
+ run([{ "4.4.8", "Invalid Unknown CRL Entry Extension Test8",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.9", "Invalid Unknown CRL Extension Test9",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.10", "Invalid Unknown CRL Extension Test10",
+ {bad_cert, revocation_status_undetermined}}]).
+
+old_CRL(doc) ->
+ [""];
+old_CRL(suite) ->
+ [];
+old_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.11", "Invalid Old CRL nextUpdate Test11",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12",
+ {bad_cert, revocation_status_undetermined}}]).
+
+fresh_CRL(doc) ->
+ [""];
+fresh_CRL(suite) ->
+ [];
+fresh_CRL(Config) when is_list(Config) ->
+ run([{ "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}]).
+
+valid_serial(doc) ->
+ [""];
+valid_serial(suite) ->
+ [];
+valid_serial(Config) when is_list(Config) ->
+ run([
+ { "4.4.14", "Valid Negative Serial Number Test14",ok},
+ { "4.4.16", "Valid Long Serial Number Test16", ok},
+ { "4.4.17", "Valid Long Serial Number Test17", ok}
+ ]).
+
+invalid_serial(doc) ->
+ [""];
+invalid_serial(suite) ->
+ [];
+invalid_serial(Config) when is_list(Config) ->
+ run([{ "4.4.15", "Invalid Negative Serial Number Test15",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.18", "Invalid Long Serial Number Test18",
+ {bad_cert, {revoked, keyCompromise}}}]).
+
+valid_seperate_keys(doc) ->
+ [""];
+valid_seperate_keys(suite) ->
+ [];
+valid_seperate_keys(Config) when is_list(Config) ->
+ run([{ "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}]).
+
+invalid_separate_keys(doc) ->
+ [""];
+invalid_separate_keys(suite) ->
+ [];
+invalid_separate_keys(Config) when is_list(Config) ->
+ run([{ "4.4.20", "Invalid Separate Certificate and CRL Keys Test20",
+ {bad_cert, {revoked, keyCompromise}}},
+ { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+%%-----------------------------------------------------------------------------
+missing_basic_constraints(doc) ->
+ [""];
+missing_basic_constraints(suite) ->
+ [];
+missing_basic_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.1", "Invalid Missing basicConstraints Test1",
+ {bad_cert, missing_basic_constraint}},
+ { "4.6.2", "Invalid cA False Test2",
+ {bad_cert, missing_basic_constraint}},
+ { "4.6.3", "Invalid cA False Test3",
+ {bad_cert, missing_basic_constraint}}]).
+
+valid_basic_constraint(doc) ->
+ [""];
+valid_basic_constraint(suite) ->
+ [];
+valid_basic_constraint(Config) when is_list(Config) ->
+ run([{"4.6.4", "Valid basicConstraints Not Critical Test4", ok}]).
+
+invalid_path_constraints(doc) ->
+ [""];
+invalid_path_constraints(suite) ->
+ [];
+invalid_path_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}},
+ { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}},
+ { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}},
+ { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}},
+ { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}},
+ { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}},
+ { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16",
+ {bad_cert, max_path_length_reached}}]).
-signature_verification(doc) -> [""];
-signature_verification(suite) -> [];
-signature_verification(Config) when is_list(Config) ->
- run(signature_verification()).
-validity_periods(doc) -> [""];
-validity_periods(suite) -> [];
-validity_periods(Config) when is_list(Config) ->
- run(validity_periods()).
-verifying_name_chaining(doc) -> [""];
-verifying_name_chaining(suite) -> [];
-verifying_name_chaining(Config) when is_list(Config) ->
- run(verifying_name_chaining()).
-basic_certificate_revocation_tests(doc) -> [""];
-basic_certificate_revocation_tests(suite) -> [];
-basic_certificate_revocation_tests(Config) when is_list(Config) ->
- run(basic_certificate_revocation_tests()).
-verifying_paths_with_self_issued_certificates(doc) -> [""];
-verifying_paths_with_self_issued_certificates(suite) -> [];
-verifying_paths_with_self_issued_certificates(Config) when is_list(Config) ->
- run(verifying_paths_with_self_issued_certificates()).
-verifying_basic_constraints(doc) -> [""];
-verifying_basic_constraints(suite) -> [];
-verifying_basic_constraints(Config) when is_list(Config) ->
- run(verifying_basic_constraints()).
-key_usage(doc) -> [""];
-key_usage(suite) -> [];
-key_usage(Config) when is_list(Config) ->
- run(key_usage()).
+valid_path_constraints(doc) ->
+ [""];
+valid_path_constraints(suite) ->
+ [];
+valid_path_constraints(Config) when is_list(Config) ->
+ run([{ "4.6.7", "Valid pathLenConstraint Test7", ok},
+ { "4.6.8", "Valid pathLenConstraint Test8", ok},
+ { "4.6.13", "Valid pathLenConstraint Test13", ok},
+ { "4.6.14", "Valid pathLenConstraint Test14", ok},
+ { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok},
+ { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]).
+
+%%-----------------------------------------------------------------------------
+invalid_key_usage(doc) ->
+ [""];
+invalid_key_usage(suite) ->
+ [];
+invalid_key_usage(Config) when is_list(Config) ->
+ run([{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1",
+ {bad_cert,invalid_key_usage} },
+ { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2",
+ {bad_cert,invalid_key_usage}},
+ { "4.7.4", "Invalid keyUsage Critical cRLSign False Test4",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_key_usage(doc) ->
+ [""];
+valid_key_usage(suite) ->
+ [];
+valid_key_usage(Config) when is_list(Config) ->
+ run([{ "4.7.3", "Valid keyUsage Not Critical Test3", ok}]).
+
+%%-----------------------------------------------------------------------------
certificate_policies(doc) -> [""];
certificate_policies(suite) -> [];
certificate_policies(Config) when is_list(Config) ->
run(certificate_policies()).
+%%-----------------------------------------------------------------------------
require_explicit_policy(doc) -> [""];
require_explicit_policy(suite) -> [];
require_explicit_policy(Config) when is_list(Config) ->
run(require_explicit_policy()).
+%%-----------------------------------------------------------------------------
policy_mappings(doc) -> [""];
policy_mappings(suite) -> [];
policy_mappings(Config) when is_list(Config) ->
run(policy_mappings()).
+%%-----------------------------------------------------------------------------
inhibit_policy_mapping(doc) -> [""];
inhibit_policy_mapping(suite) -> [];
inhibit_policy_mapping(Config) when is_list(Config) ->
run(inhibit_policy_mapping()).
+%%-----------------------------------------------------------------------------
inhibit_any_policy(doc) -> [""];
inhibit_any_policy(suite) -> [];
inhibit_any_policy(Config) when is_list(Config) ->
run(inhibit_any_policy()).
-name_constraints(doc) -> [""];
-name_constraints(suite) -> [];
-name_constraints(Config) when is_list(Config) ->
- run(name_constraints()).
-distribution_points(doc) -> [""];
-distribution_points(suite) -> [];
-distribution_points(Config) when is_list(Config) ->
- run(distribution_points()).
-delta_crls(doc) -> [""];
-delta_crls(suite) -> [];
-delta_crls(Config) when is_list(Config) ->
- run(delta_crls()).
-private_certificate_extensions(doc) -> [""];
-private_certificate_extensions(suite) -> [];
-private_certificate_extensions(Config) when is_list(Config) ->
- run(private_certificate_extensions()).
-
-run() ->
- Tests =
- [signature_verification(),
- validity_periods(),
- verifying_name_chaining(),
- %%basic_certificate_revocation_tests(),
- verifying_paths_with_self_issued_certificates(),
- verifying_basic_constraints(),
- key_usage(),
- %%certificate_policies(),
- %%require_explicit_policy(),
- %%policy_mappings(),
- %%inhibit_policy_mapping(),
- %%inhibit_any_policy(),
- name_constraints(),
- %distribution_points(),
- %delta_crls(),
- private_certificate_extensions()
- ],
- run(lists:append(Tests)).
+%%-----------------------------------------------------------------------------
+
+valid_DN_name_constraints(doc) ->
+ [""];
+valid_DN_name_constraints(suite) ->
+ [];
+valid_DN_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.1", "Valid DN nameConstraints Test1", ok},
+ { "4.13.4", "Valid DN nameConstraints Test4", ok},
+ { "4.13.5", "Valid DN nameConstraints Test5", ok},
+ { "4.13.6", "Valid DN nameConstraints Test6", ok},
+ { "4.13.11", "Valid DN nameConstraints Test11", ok},
+ { "4.13.14", "Valid DN nameConstraints Test14", ok},
+ { "4.13.18", "Valid DN nameConstraints Test18", ok},
+ { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}]).
+
+invalid_DN_name_constraints(doc) ->
+ [""];
+invalid_DN_name_constraints(suite) ->
+ [];
+invalid_DN_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}},
+ { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}},
+ { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}},
+ { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}},
+ { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}},
+ { "4.13.10", "Invalid DN nameConstraints Test10",{bad_cert, name_not_permitted}},
+ { "4.13.12", "Invalid DN nameConstraints Test12",{bad_cert, name_not_permitted}},
+ { "4.13.13", "Invalid DN nameConstraints Test13",{bad_cert, name_not_permitted}},
+ { "4.13.15", "Invalid DN nameConstraints Test15",{bad_cert, name_not_permitted}},
+ { "4.13.16", "Invalid DN nameConstraints Test16",{bad_cert, name_not_permitted}},
+ { "4.13.17", "Invalid DN nameConstraints Test17",{bad_cert, name_not_permitted}},
+ { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20",
+ {bad_cert, name_not_permitted}}]).
+
+valid_rfc822_name_constraints(doc) ->
+ [""];
+valid_rfc822_name_constraints(suite) ->
+ [];
+valid_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.21", "Valid RFC822 nameConstraints Test21", ok},
+ { "4.13.23", "Valid RFC822 nameConstraints Test23", ok},
+ { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}]).
+
+
+invalid_rfc822_name_constraints(doc) ->
+ [""];
+invalid_rfc822_name_constraints(suite) ->
+ [];
+invalid_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.22", "Invalid RFC822 nameConstraints Test22",
+ {bad_cert, name_not_permitted}},
+ { "4.13.24", "Invalid RFC822 nameConstraints Test24",
+ {bad_cert, name_not_permitted}},
+ { "4.13.26", "Invalid RFC822 nameConstraints Test26",
+ {bad_cert, name_not_permitted}}]).
+
+valid_DN_and_rfc822_name_constraints(doc) ->
+ [""];
+valid_DN_and_rfc822_name_constraints(suite) ->
+ [];
+valid_DN_and_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}]).
+
+invalid_DN_and_rfc822_name_constraints(doc) ->
+ [""];
+invalid_DN_and_rfc822_name_constraints(suite) ->
+ [];
+invalid_DN_and_rfc822_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.28", "Invalid DN and RFC822 nameConstraints Test28",
+ {bad_cert, name_not_permitted}},
+ { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29",
+ {bad_cert, name_not_permitted}}]).
+
+valid_dns_name_constraints(doc) ->
+ [""];
+valid_dns_name_constraints(suite) ->
+ [];
+valid_dns_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.30", "Valid DNS nameConstraints Test30", ok},
+ { "4.13.32", "Valid DNS nameConstraints Test32", ok}]).
+
+invalid_dns_name_constraints(doc) ->
+ [""];
+invalid_dns_name_constraints(suite) ->
+ [];
+invalid_dns_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted}},
+ { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}},
+ { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted}}]).
+
+valid_uri_name_constraints(doc) ->
+ [""];
+valid_uri_name_constraints(suite) ->
+ [];
+valid_uri_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.34", "Valid URI nameConstraints Test34", ok},
+ { "4.13.36", "Valid URI nameConstraints Test36", ok}]).
+
+invalid_uri_name_constraints(doc) ->
+ [""];
+invalid_uri_name_constraints(suite) ->
+ [];
+invalid_uri_name_constraints(Config) when is_list(Config) ->
+ run([{ "4.13.35", "Invalid URI nameConstraints Test35",{bad_cert, name_not_permitted}},
+ { "4.13.37", "Invalid URI nameConstraints Test37",{bad_cert, name_not_permitted}}]).
+
+%%-----------------------------------------------------------------------------
+delta_without_crl(doc) ->
+ [""];
+delta_without_crl(suite) ->
+ [];
+delta_without_crl(Config) when is_list(Config) ->
+ run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1",{bad_cert,
+ revocation_status_undetermined}},
+ {"4.15.10", "Invalid delta-CRL Test10", {bad_cert,
+ revocation_status_undetermined}}]).
+
+valid_delta_crls(doc) ->
+ [""];
+valid_delta_crls(suite) ->
+ [];
+valid_delta_crls(Config) when is_list(Config) ->
+ run([{ "4.15.2", "Valid delta-CRL Test2", ok},
+ { "4.15.5", "Valid delta-CRL Test5", ok},
+ { "4.15.7", "Valid delta-CRL Test7", ok},
+ { "4.15.8", "Valid delta-CRL Test8", ok}
+ ]).
+
+invalid_delta_crls(doc) ->
+ [""];
+invalid_delta_crls(suite) ->
+ [];
+invalid_delta_crls(Config) when is_list(Config) ->
+ run([{ "4.15.3", "Invalid delta-CRL Test3", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.4", "Invalid delta-CRL Test4", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.6", "Invalid delta-CRL Test6", {bad_cert,{revoked, keyCompromise}}},
+ { "4.15.9", "Invalid delta-CRL Test9", {bad_cert,{revoked, keyCompromise}}}]).
+
+%%-----------------------------------------------------------------------------
+
+valid_distribution_points(doc) ->
+ [""];
+valid_distribution_points(suite) ->
+ [];
+valid_distribution_points(Config) when is_list(Config) ->
+ run([{ "4.14.1", "Valid distributionPoint Test1", ok},
+ { "4.14.4", "Valid distributionPoint Test4", ok},
+ { "4.14.5", "Valid distributionPoint Test5", ok},
+ { "4.14.7", "Valid distributionPoint Test7", ok}
+ ]).
+
+valid_distribution_points_no_issuing_distribution_point(doc) ->
+ [""];
+valid_distribution_points_no_issuing_distribution_point(suite) ->
+ [];
+valid_distribution_points_no_issuing_distribution_point(Config) when is_list(Config) ->
+ run([{ "4.14.10", "Valid No issuingDistributionPoint Test10", ok}
+ ]).
+
+invalid_distribution_points(doc) ->
+ [""];
+invalid_distribution_points(suite) ->
+ [];
+invalid_distribution_points(Config) when is_list(Config) ->
+ run([{ "4.14.2", "Invalid distributionPoint Test2", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.3", "Invalid distributionPoint Test3", {bad_cert,
+ revocation_status_undetermined}},
+ { "4.14.6", "Invalid distributionPoint Test6", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.8", "Invalid distributionPoint Test8", {bad_cert,
+ revocation_status_undetermined}},
+ { "4.14.9", "Invalid distributionPoint Test9", {bad_cert,
+ revocation_status_undetermined}}
+ ]).
+
+valid_only_contains(doc) ->
+ [""];
+valid_only_contains(suite) ->
+ [];
+valid_only_contains(Config) when is_list(Config) ->
+ run([{ "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}]).
+
+invalid_only_contains(doc) ->
+ [""];
+invalid_only_contains(suite) ->
+ [];
+invalid_only_contains(Config) when is_list(Config) ->
+ run([{ "4.14.11", "Invalid onlyContainsUserCerts CRL Test11",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.12", "Invalid onlyContainsCACerts CRL Test12",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.14", "Invalid onlyContainsAttributeCerts Test14",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_only_some_reasons(doc) ->
+ [""];
+valid_only_some_reasons(suite) ->
+ [];
+valid_only_some_reasons(Config) when is_list(Config) ->
+ run([{ "4.14.18", "Valid onlySomeReasons Test18", ok},
+ { "4.14.19", "Valid onlySomeReasons Test19", ok}
+ ]).
+
+invalid_only_some_reasons(doc) ->
+ [""];
+invalid_only_some_reasons(suite) ->
+ [];
+invalid_only_some_reasons(Config) when is_list(Config) ->
+ run([{ "4.14.15", "Invalid onlySomeReasons Test15",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.16", "Invalid onlySomeReasons Test16",
+ {bad_cert,{revoked, certificateHold}}},
+ { "4.14.17", "Invalid onlySomeReasons Test17",
+ {bad_cert, revocation_status_undetermined}},
+ { "4.14.20", "Invalid onlySomeReasons Test20",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.21", "Invalid onlySomeReasons Test21",
+ {bad_cert,{revoked, affiliationChanged}}}
+ ]).
+
+valid_indirect_crl(doc) ->
+ [""];
+valid_indirect_crl(suite) ->
+ [];
+valid_indirect_crl(Config) when is_list(Config) ->
+ run([{ "4.14.22", "Valid IDP with indirectCRL Test22", ok},
+ { "4.14.24", "Valid IDP with indirectCRL Test24", ok},
+ { "4.14.25", "Valid IDP with indirectCRL Test25", ok}
+ ]).
+
+invalid_indirect_crl(doc) ->
+ [""];
+invalid_indirect_crl(suite) ->
+ [];
+invalid_indirect_crl(Config) when is_list(Config) ->
+ run([{ "4.14.23", "Invalid IDP with indirectCRL Test23",
+ {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.26", "Invalid IDP with indirectCRL Test26",
+ {bad_cert, revocation_status_undetermined}}
+ ]).
+
+valid_crl_issuer(doc) ->
+ [""];
+valid_crl_issuer(suite) ->
+ [];
+valid_crl_issuer(Config) when is_list(Config) ->
+ run([{ "4.14.28", "Valid cRLIssuer Test28", ok}%%,
+ %%{ "4.14.29", "Valid cRLIssuer Test29", ok},
+ %%{ "4.14.33", "Valid cRLIssuer Test33", ok}
+ ]).
+
+invalid_crl_issuer(doc) ->
+ [""];
+invalid_crl_issuer(suite) ->
+ [];
+invalid_crl_issuer(Config) when is_list(Config) ->
+ run([
+ { "4.14.27", "Invalid cRLIssuer Test27", {bad_cert, revocation_status_undetermined}},
+ { "4.14.31", "Invalid cRLIssuer Test31", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.32", "Invalid cRLIssuer Test32", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.34", "Invalid cRLIssuer Test34", {bad_cert,{revoked, keyCompromise}}},
+ { "4.14.35", "Invalid cRLIssuer Test35", {bad_cert, revocation_status_undetermined}}
+ ]).
+
+
+%%distribution_points() ->
+ %%{ "4.14", "Distribution Points" },
+%% [
+ %% Although this test is valid it has a circular dependency. As a result
+ %% an attempt is made to reursively checks a CRL path and rejected due to
+ %% a CRL path validation error. PKITS notes suggest this test does not
+ %% need to be run due to this issue.
+%% { "4.14.30", "Valid cRLIssuer Test30", 54 }].
+
+
+%%-----------------------------------------------------------------------------
+
+unknown_critical_extension(doc) ->
+ [""];
+unknown_critical_extension(suite) ->
+ [];
+unknown_critical_extension(Config) when is_list(Config) ->
+ run([{ "4.16.2", "Invalid Unknown Critical Certificate Extension Test2",
+ {bad_cert,unknown_critical_extension}}]).
+
+unknown_not_critical_extension(doc) ->
+ [""];
+unknown_not_critical_extension(suite) ->
+ [];
+unknown_not_critical_extension(Config) when is_list(Config) ->
+ run([{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}]).
+
+%%-----------------------------------------------------------------------------
run(Tests) ->
File = file(?CERTS,"TrustAnchorRootCertificate.crt"),
{ok, TA} = file:read_file(File),
run(Tests, TA).
run({Chap, Test, Result}, TA) ->
- CertChain = sort_chain(read_certs(Test),TA, [], false),
- try public_key:pkix_path_validation(TA, CertChain, []) of
- {Result, _} -> ok;
+ CertChain = sort_chain(read_certs(Test),TA, [], false, Chap),
+ Options = path_validation_options(TA, Chap,Test),
+ try public_key:pkix_path_validation(TA, CertChain, Options) of
+ {Result, _} -> ok;
{error,Result} when Result =/= ok ->
ok;
- {error,Error} when is_integer(Result) ->
- ?warning(" ~p~n Got ~p expected ~p~n",[Test, Error, Result]);
- {error,Error} when Result =/= ok ->
- ?error(" minor ~p~n Got ~p expected ~p~n",[Test, Error, Result]);
{error, Error} ->
?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]),
fail;
- {ok, _} when Result =/= ok ->
+ {ok, _OK} when Result =/= ok ->
?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]),
fail
catch Type:Reason ->
@@ -181,14 +821,318 @@ run([Test|Rest],TA) ->
run(Rest,TA);
run([],_) -> ok.
+path_validation_options(TA, Chap, Test) ->
+ case needs_crl_options(Chap) of
+ true ->
+ crl_options(TA, Test);
+ false ->
+ Fun =
+ fun(_,{bad_cert, _} = Reason, _) ->
+ {fail, Reason};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (_, Valid, UserState) when Valid == valid;
+ Valid == valid_peer ->
+ {valid, UserState}
+ end,
+ [{verify_fun, {Fun, []}}]
+ end.
+
+needs_crl_options("4.4" ++ _) ->
+ true;
+needs_crl_options("4.5" ++ _) ->
+ true;
+needs_crl_options("4.7.4" ++ _) ->
+ true;
+needs_crl_options("4.7.5" ++ _) ->
+ true;
+needs_crl_options("4.14" ++ _) ->
+ true;
+needs_crl_options("4.15" ++ _) ->
+ true;
+needs_crl_options(_) ->
+ false.
+
+crl_options(TA, Test) ->
+ case read_crls(Test) of
+ [] ->
+ [];
+ CRLs ->
+ Fun =
+ fun(_,{bad_cert, _} = Reason, _) ->
+ {fail, Reason};
+ (_,{extension,
+ #'Extension'{extnID = ?'id-ce-cRLDistributionPoints',
+ extnValue = Value}}, UserState0) ->
+ UserState = update_crls(Value, UserState0),
+ {valid, UserState};
+ (_,{extension, _}, UserState) ->
+ {unknown, UserState};
+ (OtpCert, Valid, UserState) when Valid == valid;
+ Valid == valid_peer ->
+ {ErlCerts, CRLs} = UserState#verify_state.crl_info,
+ CRLInfo0 =
+ crl_info(OtpCert,
+ ErlCerts,[{DerCRL, public_key:der_decode('CertificateList',
+ DerCRL)} || DerCRL <- CRLs],
+ []),
+ CRLInfo = lists:reverse(CRLInfo0),
+ Certs = UserState#verify_state.certs_db,
+ Fun = fun(DP, CRLtoValidate, Id, CertsDb) ->
+ trusted_cert_and_path(DP, CRLtoValidate, Id, CertsDb)
+ end,
+ Ignore = ignore_sign_test_when_building_path(Test),
+ case public_key:pkix_crls_validate(OtpCert, CRLInfo,
+ [{issuer_fun,{Fun, {Ignore, Certs}}}]) of
+ valid ->
+ {valid, UserState};
+ Reason ->
+ {fail, Reason}
+ end
+ end,
+
+ Certs = read_certs(Test),
+ ErlCerts = [public_key:pkix_decode_cert(Cert, otp) || Cert <- Certs],
+
+ [{verify_fun, {Fun, #verify_state{certs_db = [TA| Certs],
+ crl_info = {ErlCerts, CRLs}}}}]
+ end.
+
+crl_info(_, _, [], Acc) ->
+ Acc;
+crl_info(OtpCert, Certs, [{_, #'CertificateList'{tbsCertList =
+ #'TBSCertList'{issuer = Issuer,
+ crlExtensions = CRLExtensions}}}
+ = CRL | Rest], Acc) ->
+ OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions,
+ ExtList = pubkey_cert:extensions_list(CRLExtensions),
+ DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of
+ #'Extension'{extnValue = Value} ->
+ lists:map(fun(Point) -> pubkey_cert_records:transform(Point, decode) end, Value);
+ _ ->
+ case same_issuer(OtpCert, Issuer) of
+ true ->
+ [make_dp(ExtList, asn1_NOVALUE, Issuer)];
+ false ->
+ [make_dp(ExtList, Issuer, ignore)]
+ end
+ end,
+ DPsCRLs = lists:map(fun(DP) -> {DP, CRL} end, DPs),
+ crl_info(OtpCert, Certs, Rest, DPsCRLs ++ Acc).
+
+ignore_sign_test_when_building_path("Invalid Bad CRL Signature Test4") ->
+ true;
+ignore_sign_test_when_building_path(_) ->
+ false.
+
+same_issuer(OTPCert, Issuer) ->
+ DecIssuer = pubkey_cert_records:transform(Issuer, decode),
+ OTPTBSCert = OTPCert#'OTPCertificate'.tbsCertificate,
+ CertIssuer = OTPTBSCert#'OTPTBSCertificate'.issuer,
+ pubkey_cert:is_issuer(DecIssuer, CertIssuer).
+
+make_dp(Extensions, Issuer0, DpInfo) ->
+ {Issuer, Point} = mk_issuer_dp(Issuer0, DpInfo),
+ case pubkey_cert:select_extension('id-ce-cRLReason', Extensions) of
+ #'Extension'{extnValue = Reasons} ->
+ #'DistributionPoint'{cRLIssuer = Issuer,
+ reasons = Reasons,
+ distributionPoint = Point};
+ _ ->
+ #'DistributionPoint'{cRLIssuer = Issuer,
+ reasons = [unspecified, keyCompromise,
+ cACompromise, affiliationChanged, superseded,
+ cessationOfOperation, certificateHold,
+ removeFromCRL, privilegeWithdrawn, aACompromise],
+ distributionPoint = Point}
+ end.
+
+mk_issuer_dp(asn1_NOVALUE, Issuer) ->
+ {asn1_NOVALUE, {fullName, [{directoryName, Issuer}]}};
+mk_issuer_dp(Issuer, _) ->
+ {[{directoryName, Issuer}], asn1_NOVALUE}.
+
+update_crls(_, State) ->
+ State.
+
+trusted_cert_and_path(DP, CRL, Id, {Ignore, CertsList}) ->
+ case crl_issuer(crl_issuer_name(DP), CRL, Id, CertsList, CertsList, Ignore) of
+ {ok, IssuerCert, DerIssuerCert} ->
+ Certs = [{public_key:pkix_decode_cert(Cert, otp), Cert} || Cert <- CertsList],
+ CertChain = build_chain(Certs, Certs, IssuerCert, Ignore, [DerIssuerCert]),
+ {ok, public_key:pkix_decode_cert(hd(CertChain), otp), CertChain};
+ Other ->
+ Other
+ end.
+
+crl_issuer_name(#'DistributionPoint'{cRLIssuer = asn1_NOVALUE}) ->
+ undefined;
+crl_issuer_name(#'DistributionPoint'{cRLIssuer = [{directoryName, Issuer}]}) ->
+ pubkey_cert_records:transform(Issuer, decode).
+
+build_chain([],_, _, _,Acc) ->
+ Acc;
+
+build_chain([{First, DerFirst}|Certs], All, Cert, Ignore, Acc) ->
+ case public_key:pkix_is_self_signed(Cert) andalso is_test_root(Cert) of
+ true ->
+ Acc;
+ false ->
+ case public_key:pkix_is_issuer(Cert, First)
+ %%andalso check_extension_cert_signer(First)
+ andalso is_signer(First, Cert, Ignore)
+ of
+ true ->
+ build_chain(All, All, First, Ignore, [DerFirst | Acc]);
+ false ->
+ build_chain(Certs, All, Cert, Ignore, Acc)
+ end
+ end.
+
+is_signer(_,_, true) ->
+ true;
+is_signer(Signer, #'OTPCertificate'{} = Cert,_) ->
+ TBSCert = Signer#'OTPCertificate'.tbsCertificate,
+ PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey,
+ AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm,
+ PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters,
+ try pubkey_cert:validate_signature(Cert, public_key:pkix_encode('OTPCertificate',
+ Cert, otp),
+ PublicKey, PublicKeyParams, true, ?DEFAULT_VERIFYFUN) of
+ true ->
+ true
+ catch
+ _:_ ->
+ false
+ end;
+is_signer(Signer, #'CertificateList'{} = CRL, _) ->
+ TBSCert = Signer#'OTPCertificate'.tbsCertificate,
+ PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey,
+ AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm,
+ PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters,
+ pubkey_crl:verify_crl_signature(CRL, public_key:pkix_encode('CertificateList',
+ CRL, plain),
+ PublicKey, PublicKeyParams).
+
+is_test_root(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ {rdnSequence, AtterList} = TBSCert#'OTPTBSCertificate'.issuer,
+ lists:member([{'AttributeTypeAndValue',{2,5,4,3},{printableString,"Trust Anchor"}}],
+ AtterList).
+
+check_extension_cert_signer(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = TBSCert#'OTPTBSCertificate'.extensions,
+ case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of
+ #'Extension'{extnValue = KeyUse} ->
+ lists:member(keyCertSign, KeyUse);
+ _ ->
+ true
+ end.
+
+check_extension_crl_signer(OtpCert) ->
+ TBSCert = OtpCert#'OTPCertificate'.tbsCertificate,
+ Extensions = TBSCert#'OTPTBSCertificate'.extensions,
+ case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of
+ #'Extension'{extnValue = KeyUse} ->
+ lists:member(cRLSign, KeyUse);
+ _ ->
+ true
+ end.
+
+crl_issuer(undefined, CRL, issuer_not_found, _, CertsList, Ignore) ->
+ crl_issuer(CRL, CertsList, Ignore);
+
+crl_issuer(IssuerName, CRL, issuer_not_found, CertsList, CertsList, Ignore) ->
+ crl_issuer(IssuerName, CRL, IssuerName, CertsList, CertsList, Ignore);
+
+crl_issuer(undefined, CRL, Id, [Cert | Rest], All, false) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber,
+ Issuer = public_key:pkix_normalize_name(
+ TBSCertificate#'OTPTBSCertificate'.subject),
+ Bool = is_signer(ErlCert, CRL, false),
+ case {SerialNumber, Issuer} of
+ Id when Bool == true ->
+ {ok, ErlCert, Cert};
+ _ ->
+ crl_issuer(undefined, CRL, Id, Rest, All, false)
+ end;
+
+crl_issuer(IssuerName, CRL, Id, [Cert | Rest], All, false) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber,
+ %%Issuer = public_key:pkix_normalize_name(
+ %% TBSCertificate#'OTPTBSCertificate'.subject),
+ Bool = is_signer(ErlCert, CRL, false),
+ case {SerialNumber, IssuerName} of
+ Id when Bool == true ->
+ {ok, ErlCert, Cert};
+ {_, IssuerName} when Bool == true ->
+ {ok, ErlCert, Cert};
+ _ ->
+ crl_issuer(IssuerName, CRL, Id, Rest, All, false)
+ end;
+
+crl_issuer(undefined, CRL, _, [], CertsList, Ignore) ->
+ crl_issuer(CRL, CertsList, Ignore);
+crl_issuer(CRLName, CRL, _, [], CertsList, Ignore) ->
+ crl_issuer(CRLName, CRL, CertsList, Ignore).
+
+
+crl_issuer(_, [],_) ->
+ {error, issuer_not_found};
+crl_issuer(CRL, [Cert | Rest], Ignore) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ case public_key:pkix_is_issuer(CRL, ErlCert) andalso
+ check_extension_crl_signer(ErlCert) andalso
+ is_signer(ErlCert, CRL, Ignore)
+ of
+ true ->
+ {ok, ErlCert,Cert};
+ false ->
+ crl_issuer(CRL, Rest, Ignore)
+ end.
+
+crl_issuer(_,_, [],_) ->
+ {error, issuer_not_found};
+crl_issuer(IssuerName, CRL, [Cert | Rest], Ignore) ->
+ ErlCert = public_key:pkix_decode_cert(Cert, otp),
+ TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate,
+ Issuer = public_key:pkix_normalize_name(
+ TBSCertificate#'OTPTBSCertificate'.subject),
+
+ case
+ public_key:pkix_is_issuer(CRL, ErlCert) andalso
+ check_extension_crl_signer(ErlCert) andalso
+ is_signer(ErlCert, CRL, Ignore)
+ of
+ true ->
+ case pubkey_cert:is_issuer(Issuer, IssuerName) of
+ true ->
+ {ok, ErlCert,Cert};
+ false ->
+ crl_issuer(IssuerName, CRL, Rest, Ignore)
+ end;
+ false ->
+ crl_issuer(IssuerName, CRL, Rest, Ignore)
+ end.
read_certs(Test) ->
File = test_file(Test),
- %% io:format("Read ~p ",[File]),
Ders = erl_make_certs:pem_to_der(File),
- %% io:format("Ders ~p ~n",[length(Ders)]),
[Cert || {'Certificate', Cert, not_encrypted} <- Ders].
+read_crls(Test) ->
+ File = test_file(Test),
+ Ders = erl_make_certs:pem_to_der(File),
+ [CRL || {'CertificateList', CRL, not_encrypted} <- Ders].
+
test_file(Test) ->
file(?CONV, lists:append(string:tokens(Test, " -")) ++ ".pem").
@@ -206,118 +1150,89 @@ file(Sub,File) ->
end,
AbsFile.
-sort_chain([First|Certs], TA, Try, Found) ->
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.3"->
+ [CA, Entity, Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Self, Entity];
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.4";
+ Chap == "4.5.5" ->
+ [CA, Entity, _Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.24";
+ Chap == "4.14.25";
+ Chap == "4.14.26";
+ Chap == "4.14.27";
+ Chap == "4.14.31";
+ Chap == "4.14.32";
+ Chap == "4.14.33" ->
+ [_OtherCA, Entity, CA] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.28";
+ Chap == "4.14.29" ->
+ [CA, _OtherCA, Entity] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+
+sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.33" ->
+ [Entity, CA, _OtherCA] = do_sort_chain(Certs, TA, Acc, Bool, Chap),
+ [CA, Entity];
+
+
+sort_chain(Certs, TA, Acc, Bool, Chap) ->
+ do_sort_chain(Certs, TA, Acc, Bool, Chap).
+
+do_sort_chain([First], TA, Try, Found, Chap) when Chap == "4.5.6";
+ Chap == "4.5.7";
+ Chap == "4.4.19";
+ Chap == "4.4.20";
+ Chap == "4.4.21"->
case public_key:pkix_is_issuer(First,TA) of
true ->
- [First|sort_chain(Certs,First,Try,true)];
+ [First|do_sort_chain([],First,Try,true, Chap)];
false ->
- sort_chain(Certs,TA,[First|Try],Found)
+ do_sort_chain([],TA,[First|Try],Found, Chap)
end;
-sort_chain([], _, [],_) -> [];
-sort_chain([], Valid, Check, true) ->
- sort_chain(lists:reverse(Check), Valid, [], false);
-sort_chain([], _Valid, Check, false) ->
+do_sort_chain([First|Certs], TA, Try, Found, Chap) when Chap == "4.5.6";
+ Chap == "4.5.7";
+ Chap == "4.4.19";
+ Chap == "4.4.20";
+ Chap == "4.4.21"->
+%% case check_extension_cert_signer(public_key:pkix_decode_cert(First, otp)) of
+%% true ->
+ case public_key:pkix_is_issuer(First,TA) of
+ true ->
+ [First|do_sort_chain(Certs,First,Try,true, Chap)];
+ false ->
+ do_sort_chain(Certs,TA,[First|Try],Found, Chap)
+ end;
+%% false ->
+%% do_sort_chain(Certs, TA, Try, Found, Chap)
+%% end;
+
+do_sort_chain([First|Certs], TA, Try, Found, Chap) ->
+ case public_key:pkix_is_issuer(First,TA) of
+ true ->
+ [First|do_sort_chain(Certs,First,Try,true, Chap)];
+ false ->
+ do_sort_chain(Certs,TA,[First|Try],Found, Chap)
+ end;
+
+do_sort_chain([], _, [],_, _) -> [];
+do_sort_chain([], Valid, Check, true, Chap) ->
+ do_sort_chain(lists:reverse(Check), Valid, [], false, Chap);
+do_sort_chain([], _Valid, Check, false, _) ->
Check.
-signature_verification() ->
- %% "4.1", "Signature Verification" ,
- [{ "4.1.1", "Valid Signatures Test1", ok},
- { "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}},
- { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}},
- { "4.1.4", "Valid DSA Signatures Test4", ok},
- { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok},
- { "4.1.6", "Invalid DSA Signature Test6", {bad_cert,invalid_signature}}].
-validity_periods() ->
- %% { "4.2", "Validity Periods" },
- [{ "4.2.1", "Invalid CA notBefore Date Test1", {bad_cert, cert_expired}},
- { "4.2.2", "Invalid EE notBefore Date Test2", {bad_cert, cert_expired}},
- { "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok},
- { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok},
- { "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}},
- { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}},
- { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7", {bad_cert, cert_expired}},
- { "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}].
-verifying_name_chaining() ->
- %%{ "4.3", "Verifying Name Chaining" },
- [{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}},
- { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}},
- { "4.3.3", "Valid Name Chaining Whitespace Test3", ok},
- { "4.3.4", "Valid Name Chaining Whitespace Test4", ok},
- { "4.3.5", "Valid Name Chaining Capitalization Test5", ok},
- { "4.3.6", "Valid Name Chaining UIDs Test6", ok},
- { "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok},
- { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok},
- { "4.3.9", "Valid UTF8String Encoded Names Test9", ok},
- { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok},
- { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}].
-basic_certificate_revocation_tests() ->
- %%{ "4.4", "Basic Certificate Revocation Tests" },
- [{ "4.4.1", "Missing CRL Test1", 3 },
- { "4.4.2", "Invalid Revoked CA Test2", 23 },
- { "4.4.3", "Invalid Revoked EE Test3", 23 },
- { "4.4.4", "Invalid Bad CRL Signature Test4", 8 },
- { "4.4.5", "Invalid Bad CRL Issuer Name Test5", 3 },
- { "4.4.6", "Invalid Wrong CRL Test6", 3 },
- { "4.4.7", "Valid Two CRLs Test7", ok},
-
- %% The test document suggests these should return certificate revoked...
- %% Subsquent discussion has concluded they should not due to unhandle
- %% critical CRL extensions.
- { "4.4.8", "Invalid Unknown CRL Entry Extension Test8", 36 },
- { "4.4.9", "Invalid Unknown CRL Extension Test9", 36 },
-
- { "4.4.10", "Invalid Unknown CRL Extension Test10", 36 },
- { "4.4.11", "Invalid Old CRL nextUpdate Test11", 12 },
- { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", 12 },
- { "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok},
- { "4.4.14", "Valid Negative Serial Number Test14", ok},
- { "4.4.15", "Invalid Negative Serial Number Test15", 23 },
- { "4.4.16", "Valid Long Serial Number Test16", ok},
- { "4.4.17", "Valid Long Serial Number Test17", ok},
- { "4.4.18", "Invalid Long Serial Number Test18", 23 },
- { "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok},
- { "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", 23 },
-
- %% CRL path is revoked so get a CRL path validation error
- { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", 54 }].
-verifying_paths_with_self_issued_certificates() ->
- %%{ "4.5", "Verifying Paths with Self-Issued Certificates" },
- [{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok},
- %%{ "4.5.2", "Invalid Basic Self-Issued Old With New Test2", 23 },
- %%{ "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok},
- %%{ "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok},
- { "4.5.5", "Invalid Basic Self-Issued New With Old Test5", 23 },
- %%{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok},
- { "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", 23 },
- { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", {bad_cert,invalid_key_usage} }].
-verifying_basic_constraints() ->
- [%%{ "4.6", "Verifying Basic Constraints" },
- { "4.6.1", "Invalid Missing basicConstraints Test1",
- {bad_cert, missing_basic_constraint} },
- { "4.6.2", "Invalid cA False Test2", {bad_cert, missing_basic_constraint}},
- { "4.6.3", "Invalid cA False Test3", {bad_cert, missing_basic_constraint}},
- { "4.6.4", "Valid basicConstraints Not Critical Test4", ok},
- { "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}},
- { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}},
- { "4.6.7", "Valid pathLenConstraint Test7", ok},
- { "4.6.8", "Valid pathLenConstraint Test8", ok},
- { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}},
- { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}},
- { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}},
- { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}},
- { "4.6.13", "Valid pathLenConstraint Test13", ok},
- { "4.6.14", "Valid pathLenConstraint Test14", ok},
- { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok},
- { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", {bad_cert, max_path_length_reached}},
- { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}].
-key_usage() ->
- %%{ "4.7", "Key Usage" },
- [{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", {bad_cert,invalid_key_usage} },
- { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", {bad_cert,invalid_key_usage} },
- { "4.7.3", "Valid keyUsage Not Critical Test3", ok}
- %%,{ "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", 35 }
- %%,{ "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", 35 }
- ].
+error(Format, Args, File0, Line) ->
+ File = filename:basename(File0),
+ Pid = group_leader(),
+ Pid ! {failed, File, Line},
+ io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]).
+
+warning(Format, Args, File0, Line) ->
+ File = filename:basename(File0),
+ io:format("~s(~p): Warning "++Format, [File,Line|Args]).
%% Certificate policy tests need special handling. They can have several
%% sub tests and we need to check the outputs are correct.
@@ -425,182 +1340,3 @@ inhibit_any_policy() ->
{"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 },
{"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok},
{"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }].
-
-name_constraints() ->
- %%{ "4.13", "Name Constraints" },
- [{ "4.13.1", "Valid DN nameConstraints Test1", ok},
- { "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}},
- { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}},
- { "4.13.4", "Valid DN nameConstraints Test4", ok},
- { "4.13.5", "Valid DN nameConstraints Test5", ok},
- { "4.13.6", "Valid DN nameConstraints Test6", ok},
- { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}},
- { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}},
- { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}},
- { "4.13.10", "Invalid DN nameConstraints Test10", {bad_cert, name_not_permitted}},
- { "4.13.11", "Valid DN nameConstraints Test11", ok},
- { "4.13.12", "Invalid DN nameConstraints Test12", {bad_cert, name_not_permitted}},
- { "4.13.13", "Invalid DN nameConstraints Test13", {bad_cert, name_not_permitted}},
- { "4.13.14", "Valid DN nameConstraints Test14", ok},
- { "4.13.15", "Invalid DN nameConstraints Test15", {bad_cert, name_not_permitted}},
- { "4.13.16", "Invalid DN nameConstraints Test16", {bad_cert, name_not_permitted}},
- { "4.13.17", "Invalid DN nameConstraints Test17", {bad_cert, name_not_permitted}},
- { "4.13.18", "Valid DN nameConstraints Test18", ok},
- { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok},
- { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", {bad_cert, name_not_permitted} },
- { "4.13.21", "Valid RFC822 nameConstraints Test21", ok},
- { "4.13.22", "Invalid RFC822 nameConstraints Test22", {bad_cert, name_not_permitted} },
- { "4.13.23", "Valid RFC822 nameConstraints Test23", ok},
- { "4.13.24", "Invalid RFC822 nameConstraints Test24", {bad_cert, name_not_permitted} },
- { "4.13.25", "Valid RFC822 nameConstraints Test25", ok},
- { "4.13.26", "Invalid RFC822 nameConstraints Test26", {bad_cert, name_not_permitted}},
- { "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok},
- { "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", {bad_cert, name_not_permitted} },
- { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", {bad_cert, name_not_permitted} },
- { "4.13.30", "Valid DNS nameConstraints Test30", ok},
- { "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted} },
- { "4.13.32", "Valid DNS nameConstraints Test32", ok},
- { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}},
- { "4.13.34", "Valid URI nameConstraints Test34", ok},
- { "4.13.35", "Invalid URI nameConstraints Test35", {bad_cert, name_not_permitted} },
- { "4.13.36", "Valid URI nameConstraints Test36", ok},
- { "4.13.37", "Invalid URI nameConstraints Test37", {bad_cert, name_not_permitted}},
- { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted} }].
-distribution_points() ->
- %%{ "4.14", "Distribution Points" },
- [{ "4.14.1", "Valid distributionPoint Test1", ok},
- { "4.14.2", "Invalid distributionPoint Test2", 23 },
- { "4.14.3", "Invalid distributionPoint Test3", 44 },
- { "4.14.4", "Valid distributionPoint Test4", ok},
- { "4.14.5", "Valid distributionPoint Test5", ok},
- { "4.14.6", "Invalid distributionPoint Test6", 23 },
- { "4.14.7", "Valid distributionPoint Test7", ok},
- { "4.14.8", "Invalid distributionPoint Test8", 44 },
- { "4.14.9", "Invalid distributionPoint Test9", 44 },
- { "4.14.10", "Valid No issuingDistributionPoint Test10", ok},
- { "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", 44 },
- { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", 44 },
- { "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok},
- { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", 44 },
- { "4.14.15", "Invalid onlySomeReasons Test15", 23 },
- { "4.14.16", "Invalid onlySomeReasons Test16", 23 },
- { "4.14.17", "Invalid onlySomeReasons Test17", 3 },
- { "4.14.18", "Valid onlySomeReasons Test18", ok},
- { "4.14.19", "Valid onlySomeReasons Test19", ok},
- { "4.14.20", "Invalid onlySomeReasons Test20", 23 },
- { "4.14.21", "Invalid onlySomeReasons Test21", 23 },
- { "4.14.22", "Valid IDP with indirectCRL Test22", ok},
- { "4.14.23", "Invalid IDP with indirectCRL Test23", 23 },
- { "4.14.24", "Valid IDP with indirectCRL Test24", ok},
- { "4.14.25", "Valid IDP with indirectCRL Test25", ok},
- { "4.14.26", "Invalid IDP with indirectCRL Test26", 44 },
- { "4.14.27", "Invalid cRLIssuer Test27", 3 },
- { "4.14.28", "Valid cRLIssuer Test28", ok},
- { "4.14.29", "Valid cRLIssuer Test29", ok},
-
- %% Although this test is valid it has a circular dependency. As a result
- %% an attempt is made to reursively checks a CRL path and rejected due to
- %% a CRL path validation error. PKITS notes suggest this test does not
- %% need to be run due to this issue.
- { "4.14.30", "Valid cRLIssuer Test30", 54 },
- { "4.14.31", "Invalid cRLIssuer Test31", 23 },
- { "4.14.32", "Invalid cRLIssuer Test32", 23 },
- { "4.14.33", "Valid cRLIssuer Test33", ok},
- { "4.14.34", "Invalid cRLIssuer Test34", 23 },
- { "4.14.35", "Invalid cRLIssuer Test35", 44 }].
-delta_crls() ->
- %%{ "4.15", "Delta-CRLs" },
- [{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1", 3 },
- { "4.15.2", "Valid delta-CRL Test2", ok},
- { "4.15.3", "Invalid delta-CRL Test3", 23 },
- { "4.15.4", "Invalid delta-CRL Test4", 23 },
- { "4.15.5", "Valid delta-CRL Test5", ok},
- { "4.15.6", "Invalid delta-CRL Test6", 23 },
- { "4.15.7", "Valid delta-CRL Test7", ok},
- { "4.15.8", "Valid delta-CRL Test8", ok},
- { "4.15.9", "Invalid delta-CRL Test9", 23 },
- { "4.15.10", "Invalid delta-CRL Test10", 12 }].
-private_certificate_extensions() ->
- %%{ "4.16", "Private Certificate Extensions" },
- [{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok},
- { "4.16.2", "Invalid Unknown Critical Certificate Extension Test2",
- {bad_cert,unknown_critical_extension}}].
-
-
-convert() ->
- Tests = [signature_verification(),
- validity_periods(),
- verifying_name_chaining(),
- basic_certificate_revocation_tests(),
- verifying_paths_with_self_issued_certificates(),
- verifying_basic_constraints(),
- key_usage(),
- certificate_policies(),
- require_explicit_policy(),
- policy_mappings(),
- inhibit_policy_mapping(),
- inhibit_any_policy(),
- name_constraints(),
- distribution_points(),
- delta_crls(),
- private_certificate_extensions()],
- [convert(Test) || Test <- lists:flatten(Tests)].
-
-convert({_,Test,_}) ->
- convert1(Test);
-convert({_,Test,_,_,_,_,_}) ->
- convert1(Test).
-
-convert1(Test) ->
- FName = lists:append(string:tokens(Test, " -")),
- File = filename:join(?MIME, "Signed" ++ FName ++ ".eml"),
- io:format("Convert ~p~n",[File]),
- {ok, Mail} = file:read_file(File),
- Base64 = skip_lines(Mail),
- %%io:format("~s",[Base64]),
- Tmp = base64:mime_decode(Base64),
- file:write_file("pkits/smime-pem/tmp-pkcs7.der", Tmp),
- Cmd = "openssl pkcs7 -inform der -in pkits/smime-pem/tmp-pkcs7.der"
- " -print_certs -out pkits/smime-pem/" ++ FName ++ ".pem",
- case os:cmd(Cmd) of
- "" -> ok;
- Err ->
- io:format("~s",[Err]),
- erlang:error(bad_cmd)
- end.
-
-skip_lines(<<"\r\n\r\n", Rest/binary>>) -> Rest;
-skip_lines(<<"\n\n", Rest/binary>>) -> Rest;
-skip_lines(<<_:8, Rest/binary>>) ->
- skip_lines(Rest).
-
-init_per_testcase(_Func, Config) ->
- Datadir = proplists:get_value(data_dir, Config),
- put(datadir, Datadir),
- Config.
-
-end_per_testcase(_Func, Config) ->
- %% Nodes = select_nodes(all, Config, ?FILE, ?LINE),
- %% rpc:multicall(Nodes, mnesia, lkill, []),
- Config.
-
-init_per_suite(Config) ->
- try crypto:start() of
- ok ->
- Config
- catch _:_ ->
- {skip, "Crypto did not start"}
- end.
-
-end_per_suite(_Config) ->
- application:stop(crypto).
-
-error(Format, Args, File0, Line) ->
- File = filename:basename(File0),
- Pid = group_leader(),
- Pid ! {failed, File, Line},
- io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]).
-
-warning(Format, Args, File0, Line) ->
- File = filename:basename(File0),
- io:format("~s(~p): Warning "++Format, [File,Line|Args]).
diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk
index c99fd6fee1..3c6b012152 100644
--- a/lib/public_key/vsn.mk
+++ b/lib/public_key/vsn.mk
@@ -1 +1 @@
-PUBLIC_KEY_VSN = 0.11
+PUBLIC_KEY_VSN = 0.12
diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl
index 38e486b7a7..13753565d8 100644
--- a/lib/sasl/src/rb.erl
+++ b/lib/sasl/src/rb.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -169,7 +169,7 @@ print_filters() ->
print_dates() ->
io:format(" - {StartDate, EndDate}~n"),
- io:format(" StartDate = EndDate = {{Y-M-D},{H,M,S}} ~n"),
+ io:format(" StartDate = EndDate = {{Y,M,D},{H,M,S}} ~n"),
io:format(" prints the reports with date between StartDate and EndDate~n"),
io:format(" - {StartDate, from}~n"),
io:format(" prints the reports with date greater than StartDate~n"),
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index af667b1a71..4f546a37ed 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -29,6 +29,33 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 2.0.6</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ A memory leak has been fixed. I.e. per terminated connection the size of
+ a pid and the length of a user name string was not cleared.</p>
+ <p>
+ Own Id: OTP-9232</p>
+ </item>
+ </list>
+ </section>
+</section>
+
+<section><title>Ssh 2.0.5</title>
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Strengthened random number generation. (Thanks to Geoff Cant)</p>
+ <p>
+ Own Id: OTP-9225</p>
+ </item>
+ </list>
+ </section>
+</section>
+
<section><title>Ssh 2.0.4</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src
index 501da8ceb9..37f24e2463 100644
--- a/lib/ssh/src/ssh.appup.src
+++ b/lib/ssh/src/ssh.appup.src
@@ -19,34 +19,12 @@
{"%VSN%",
[
- {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_rsa, soft_purge, soft_purge, []},
- {load_module, ssh_acceptor, soft_purge, soft_purge, []},
- {load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_rsa, soft_purge, soft_purge, []},
- {load_module, ssh_acceptor, soft_purge, soft_purge, []},
- {load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.1", [{restart_application, ssh}]}
+ {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]}
],
[
- {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_rsa, soft_purge, soft_purge, []},
- {load_module, ssh_acceptor, soft_purge, soft_purge, []},
- {load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_rsa, soft_purge, soft_purge, []},
- {load_module, ssh_acceptor, soft_purge, soft_purge, []},
- {load_module, ssh_transport, soft_purge, soft_purge, []},
- {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]},
- {"2.0.1", [{restart_application, ssh}]}
+ {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []},
+ {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]}
]
}.
diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl
index 399581a0fd..3f0a06575c 100755
--- a/lib/ssh/src/ssh_bits.erl
+++ b/lib/ssh/src/ssh_bits.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -34,7 +34,7 @@
%% integer utils
-export([isize/1]).
-export([irandom/1, irandom/3]).
--export([random/1, random/3]).
+-export([random/1]).
-export([xor_bits/2, fill_bits/2]).
-export([i2bin/2, bin2i/1]).
@@ -401,9 +401,6 @@ xor_bits(XBits, YBits) ->
irandom(Bits) ->
irandom(Bits, 1, 0).
-%% irandom_odd(Bits) ->
-%% irandom(Bits, 1, 1).
-
%%
%% irandom(N, Top, Bottom)
%%
@@ -414,57 +411,16 @@ irandom(Bits) ->
%% Bot = 0 - do not set the least signifcant bit
%% Bot = 1 - set the least signifcant bit (i.e always odd)
%%
-irandom(0, _Top, _Bottom) ->
- 0;
-irandom(Bits, Top, Bottom) ->
- Bytes = (Bits+7) div 8,
- Skip = (8-(Bits rem 8)) rem 8,
- TMask = case Top of
- 0 -> 0;
- 1 -> 16#80;
- 2 -> 16#c0
- end,
- BMask = case Bottom of
- 0 -> 0;
- 1 -> (1 bsl Skip)
- end,
- <<X:Bits/big-unsigned-integer, _:Skip>> = random(Bytes, TMask, BMask),
- X.
+irandom(Bits, Top, Bottom) when is_integer(Top),
+ 0 =< Top, Top =< 2 ->
+ crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)).
%%
%% random/1
%% Generate N random bytes
%%
random(N) ->
- random(N, 0, 0).
-
-random(N, TMask, BMask) ->
- list_to_binary(rnd(N, TMask, BMask)).
-
-%% random/3
-%% random(Bytes, TopMask, BotMask)
-%% where
-%% Bytes is the number of bytes to generate
-%% TopMask is bitwised or'ed to the first byte
-%% BotMask is bitwised or'ed to the last byte
-%%
-rnd(0, _TMask, _BMask) ->
- [];
-rnd(1, TMask, BMask) ->
- [(rand8() bor TMask) bor BMask];
-rnd(N, TMask, BMask) ->
- [(rand8() bor TMask) | rnd_n(N-1, BMask)].
-
-rnd_n(1, BMask) ->
- [rand8() bor BMask];
-rnd_n(I, BMask) ->
- [rand8() | rnd_n(I-1, BMask)].
-
-rand8() ->
- (rand32() bsr 8) band 16#ff.
-
-rand32() ->
- random:uniform(16#100000000) -1.
+ crypto:strong_rand_bytes(N).
%%
%% Base 64 encode/decode
diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl
index cb78acb84c..781e01b9d1 100644
--- a/lib/ssh/src/ssh_cli.erl
+++ b/lib/ssh/src/ssh_cli.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2005-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 0ba11b0a26..3193be2510 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -106,8 +106,6 @@ peer_address(ConnectionHandler) ->
%% initialize.
%%--------------------------------------------------------------------
init([Role, Manager, Socket, SshOpts]) ->
- {A,B,C} = erlang:now(),
- random:seed(A, B, C),
{NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts),
ssh_bits:install_messages(ssh_transport:transport_messages(NumVsn)),
{Protocol, Callback, CloseTag} =
@@ -580,7 +578,9 @@ handle_info({CloseTag, _Socket}, _StateName,
%% Reason. The return value is ignored.
%%--------------------------------------------------------------------
terminate(normal, _, #state{transport_cb = Transport,
- socket = Socket}) ->
+ socket = Socket,
+ manager = Pid}) ->
+ (catch ssh_userreg:delete_user(Pid)),
(catch Transport:close(Socket)),
ok;
@@ -812,7 +812,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg,
#state{ssh_params = Ssh0, manager = Pid} = State) ->
{SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0),
try
- send_msg(SshPacket, State),
+ send_msg(SshPacket, State),
ssh_connection_manager:event(Pid, Msg)
catch
exit:{noproc, _Reason} ->
@@ -824,6 +824,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg,
[Msg, Exit]),
error_logger:info_report(Report)
end,
+ (catch ssh_userreg:delete_user(Pid)),
{stop, normal, State#state{ssh_params = Ssh}}.
counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) ->
diff --git a/lib/ssh/src/ssh_userreg.erl b/lib/ssh/src/ssh_userreg.erl
index 33c801f490..f901461aea 100644
--- a/lib/ssh/src/ssh_userreg.erl
+++ b/lib/ssh/src/ssh_userreg.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -25,11 +25,18 @@
-behaviour(gen_server).
%% API
--export([start_link/0, register_user/2, lookup_user/1]).
+-export([start_link/0,
+ register_user/2,
+ lookup_user/1,
+ delete_user/1]).
%% gen_server callbacks
--export([init/1, handle_call/3, handle_cast/2, handle_info/2,
- terminate/2, code_change/3]).
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
-record(state, {user_db = []}).
@@ -46,6 +53,9 @@ start_link() ->
register_user(User, Cm) ->
gen_server:cast(?MODULE, {register, {User, Cm}}).
+delete_user(Cm) ->
+ gen_server:cast(?MODULE, {delete, Cm}).
+
lookup_user(Cm) ->
gen_server:call(?MODULE, {get_user, Cm}, infinity).
@@ -82,9 +92,10 @@ handle_call({get_user, Cm}, _From, #state{user_db = Db} = State) ->
%% {stop, Reason, State}
%% Description: Handling cast messages
%%--------------------------------------------------------------------
-handle_cast({register, UserCm}, State0) ->
- State = insert(UserCm, State0),
- {noreply, State}.
+handle_cast({register, UserCm}, State) ->
+ {noreply, insert(UserCm, State)};
+handle_cast({delete, UserCm}, State) ->
+ {noreply, delete(UserCm, State)}.
%%--------------------------------------------------------------------
%% Function: handle_info(Info, State) -> {noreply, State} |
@@ -118,6 +129,9 @@ code_change(_OldVsn, State, _Extra) ->
insert({User, Cm}, #state{user_db = Db} = State) ->
State#state{user_db = [{User, Cm} | Db]}.
+delete(Cm, #state{user_db = Db} = State) ->
+ State#state{user_db = lists:keydelete(Cm, 2, Db)}.
+
lookup(_, []) ->
undefined;
lookup(Cm, [{User, Cm} | _Rest]) ->
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 51f9f47446..d0861b3ddc 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 2.0.4
+SSH_VSN = 2.0.6
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index cd5c9281cd..0da6bbee5b 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -53,13 +53,11 @@
<p>The following data types are used in the functions below:
</p>
- <p><c>boolean() = true | false</c></p>
-
- <p><c>property() = atom()</c></p>
-
+ <p><c>boolean() = true | false</c></p>
+
<p><c>option() = socketoption() | ssloption() | transportoption()</c></p>
- <p><c>socketoption() = [{property(), term()}] - defaults to
+ <p><c>socketoption() = proplists:property() - The default socket options are
[{mode,list},{packet, 0},{header, 0},{active, true}].
</c></p>
@@ -266,7 +264,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
<p>Possible path validation errors: </p>
-<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p>
+<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p>
</item>
<tag>{hibernate_after, integer()|undefined}</tag>
@@ -488,7 +486,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
<fsummary>Get the value of the specified options.</fsummary>
<type>
<v>Socket = sslsocket()</v>
- <v>OptionNames = [property()]</v>
+ <v>OptionNames = [atom()]</v>
</type>
<desc>
<p>Get the value of the specified socket options, if no
@@ -583,7 +581,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} |
<fsummary>Write data to a socket.</fsummary>
<type>
<v>Socket = sslsocket()</v>
- <v>Data = iolist() | binary()</v>
+ <v>Data = iodata()</v>
</type>
<desc>
<p>Writes <c>Data</c> to <c>Socket</c>. </p>
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index d3e426f254..a0ecb4ac6f 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,6 +1,7 @@
%% -*- erlang -*-
{"%VSN%",
[
+ {"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
{"4.1.2", [{restart_application, ssl}]},
{"4.1.1", [{restart_application, ssl}]},
@@ -8,6 +9,7 @@
{"4.0.1", [{restart_application, ssl}]}
],
[
+ {"4.1.4", [{restart_application, ssl}]},
{"4.1.3", [{restart_application, ssl}]},
{"4.1.2", [{restart_application, ssl}]},
{"4.1.1", [{restart_application, ssl}]},
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 7b1fda4cf9..380c59b058 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -50,8 +50,7 @@
cb %% Callback info
}).
-type option() :: socketoption() | ssloption() | transportoption().
--type socketoption() :: [{property(), term()}]. %% See gen_tcp and inet
--type property() :: atom().
+-type socketoption() :: term(). %% See gen_tcp and inet, import spec later when there is one to import
-type ssloption() :: {verify, verify_type()} |
{verify_fun, {fun(), InitialUserState::term()}} |
{fail_if_no_peer_cert, boolean()} | {depth, integer()} |
@@ -264,7 +263,7 @@ close(Socket = #sslsocket{}) ->
ssl_broker:close(Socket).
%%--------------------------------------------------------------------
--spec send(#sslsocket{}, iolist()) -> ok | {error, reason()}.
+-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}.
%%
%% Description: Sends data over the ssl connection
%%--------------------------------------------------------------------
@@ -403,9 +402,9 @@ cipher_suites(openssl) ->
[ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)].
%%--------------------------------------------------------------------
--spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}.
+-spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]} | {error, reason()}.
%%
-%% Description:
+%% Description: Gets options
%%--------------------------------------------------------------------
getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptTags) when is_pid(Pid) ->
ssl_connection:get_opts(Pid, OptTags);
@@ -416,9 +415,9 @@ getopts(#sslsocket{} = Socket, Options) ->
ssl_broker:getopts(Socket, Options).
%%--------------------------------------------------------------------
--spec setopts(#sslsocket{}, [{atom(), term()}]) -> ok | {error, reason()}.
+-spec setopts(#sslsocket{}, [proplist:property()]) -> ok | {error, reason()}.
%%
-%% Description:
+%% Description: Sets options
%%--------------------------------------------------------------------
setopts(#sslsocket{fd = new_ssl, pid = Pid}, Opts0) when is_pid(Pid) ->
Opts = proplists:expand([{binary, [{mode, binary}]},
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 574e1e9468..0a86e9bd29 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -107,12 +107,14 @@
%%====================================================================
%%--------------------------------------------------------------------
--spec send(pid(), iolist()) -> ok | {error, reason()}.
+-spec send(pid(), iodata()) -> ok | {error, reason()}.
%%
%% Description: Sends data over the ssl connection
%%--------------------------------------------------------------------
send(Pid, Data) ->
sync_send_all_state_event(Pid, {application_data,
+ %% iolist_to_binary should really
+ %% be called iodata_to_binary()
erlang:iolist_to_binary(Data)}, infinity).
%%--------------------------------------------------------------------
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index 2f1edfa186..0e80e42637 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 4.1.4
+SSL_VSN = 4.1.5
diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml
index 45fa0847a8..d6203bdaa0 100644
--- a/lib/stdlib/doc/src/supervisor.xml
+++ b/lib/stdlib/doc/src/supervisor.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2010</year>
+ <year>1996</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -83,11 +83,17 @@
supervisor, where all child processes are dynamically added
instances of the same process type, i.e. running the same
code.</p>
- <p>The functions <c>terminate_child/2</c>, <c>delete_child/2</c>
+ <p>The functions <c>delete_child/2</c>
and <c>restart_child/2</c> are invalid for
<c>simple_one_for_one</c> supervisors and will return
<c>{error,simple_one_for_one}</c> if the specified supervisor
uses this restart strategy.</p>
+ <p>The function <c>terminate_child/2</c> can be used for
+ children under <c>simple_one_for_one</c> supervisors by
+ giving the child's <c>pid()</c> as the second argument. If
+ instead the child specification identifier is used,
+ <c>terminate_child/2</c> will return
+ <c>{error,simple_one_for_one}</c>.</p>
</item>
</list>
<p>To prevent a supervisor from getting into an infinite loop of
@@ -311,24 +317,33 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules}
<type>
<v>SupRef = Name | {Name,Node} | {global,Name} | pid()</v>
<v>&nbsp;Name = Node = atom()</v>
- <v>Id = term()</v>
+ <v>Id = pid() | term()</v>
<v>Result = ok | {error,Error}</v>
<v>&nbsp;Error = not_found | simple_one_for_one</v>
</type>
<desc>
- <p>Tells the supervisor <c>SupRef</c> to terminate the child
- process corresponding to the child specification identified
- by <c>Id</c>. The process, if there is one, is terminated but
- the child specification is kept by the supervisor. This means
- that the child process may be later be restarted by
- the supervisor. The child process can also be restarted
- explicitly by calling <c>restart_child/2</c>. Use
- <c>delete_child/2</c> to remove the child specification.</p>
+ <p>Tells the supervisor <c>SupRef</c> to terminate the given
+ child.</p>
+ <p>If the supervisor is not <c>simple_one_for_one</c>,
+ <c>Id</c> must be the child specification identifier. The
+ process, if there is one, is terminated but the child
+ specification is kept by the supervisor. The child process
+ may later be restarted by the supervisor. The child process
+ can also be restarted explicitly by calling
+ <c>restart_child/2</c>. Use <c>delete_child/2</c> to remove
+ the child specification.</p>
+ <p>If the supervisor is <c>simple_one_for_one</c>, <c>Id</c>
+ must be the child process' <c>pid()</c>. I the specified
+ process is alive, but is not a child of the given
+ supervisor, the function will return
+ <c>{error,not_found}</c>. If the child specification
+ identifier is given instead instead of a <c>pid()</c>, the
+ function will return <c>{error,simple_one_for_one}</c>.</p>
+ <p>If successful, the function returns <c>ok</c>. If there is
+ no child specification with the specified <c>Id</c>, the
+ function returns <c>{error,not_found}</c>.</p>
<p>See <c>start_child/2</c> for a description of
<c>SupRef</c>.</p>
- <p>If successful, the function returns <c>ok</c>. If there is
- no child specification with the specified <c>Id</c>,
- the function returns <c>{error,not_found}</c>.</p>
</desc>
</func>
<func>
diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml
index e3a25a407b..cb1cfa8ed0 100644
--- a/lib/stdlib/doc/src/unicode.xml
+++ b/lib/stdlib/doc/src/unicode.xml
@@ -164,10 +164,16 @@ latin1_charlist() = [latin1_char() | latin1_binary() | latin1_charlist()]
<item>Integers out of range - If <c>InEncoding</c> is
<c>latin1</c>, an error occurs whenever an integer greater
than 255 is found in the lists. If <c>InEncoding</c> is
- of a Unicode type, error occurs whenever an integer greater than
- <c>16#10FFFF</c> (the maximum unicode character) or in the
- range <c>16#D800</c> to <c>16#DFFF</c> (invalid unicode
- range) is found.</item>
+ of a Unicode type, an error occurs whenever an integer
+ <list type="bulleted">
+ <item>greater than <c>16#10FFFF</c>
+ (the maximum unicode character),</item>
+ <item>in the range <c>16#D800</c> to <c>16#DFFF</c>
+ (invalid unicode range)</item>
+ <item>or equal to 16#FFFE or 16#FFFF (non characters)</item>
+ </list>
+ is found.
+ </item>
<item>UTF encoding incorrect - If <c>InEncoding</c> is
one of the UTF types, the bytes in any binaries have to be valid
diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 43df6f621d..574146b1cd 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -29,6 +29,8 @@
-export([init_it/6, init_it/7]).
+-export([format_status_header/2]).
+
-define(default_timeout, 5000).
%%-----------------------------------------------------------------
@@ -315,3 +317,10 @@ debug_options(Opts) ->
{ok, Options} -> sys:debug_options(Options);
_ -> []
end.
+
+format_status_header(TagLine, Pid) when is_pid(Pid) ->
+ lists:concat([TagLine, " ", pid_to_list(Pid)]);
+format_status_header(TagLine, RegName) when is_atom(RegName) ->
+ lists:concat([TagLine, " ", RegName]);
+format_status_header(TagLine, Name) ->
+ {TagLine, Name}.
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index b1e9e3a02f..b00910771f 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -724,7 +724,8 @@ get_modules(MSL) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData,
- Header = lists:concat(["Status for event handler ", ServerName]),
+ Header = gen:format_status_header("Status for event handler",
+ ServerName),
FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of
true ->
Args = [PDict, State],
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 7d9960b912..f2f1365d3d 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -614,15 +614,8 @@ get_msg(Msg) -> Msg.
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] =
StatusData,
- StatusHdr = "Status for state machine",
- Header = if
- is_pid(Name) ->
- lists:concat([StatusHdr, " ", pid_to_list(Name)]);
- is_atom(Name); is_list(Name) ->
- lists:concat([StatusHdr, " ", Name]);
- true ->
- {StatusHdr, Name}
- end,
+ Header = gen:format_status_header("Status for state machine",
+ Name),
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"StateData", StateData}]}],
Specfic =
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index ac81df9cab..09d94a9c40 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -840,15 +840,8 @@ name_to_pid(Name) ->
%%-----------------------------------------------------------------
format_status(Opt, StatusData) ->
[PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData,
- StatusHdr = "Status for generic server",
- Header = if
- is_pid(Name) ->
- lists:concat([StatusHdr, " ", pid_to_list(Name)]);
- is_atom(Name); is_list(Name) ->
- lists:concat([StatusHdr, " ", Name]);
- true ->
- {StatusHdr, Name}
- end,
+ Header = gen:format_status_header("Status for generic server",
+ Name),
Log = sys:get_debug(log, Debug, []),
DefaultStatus = [{data, [{"State", State}]}],
Specfic =
diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl
index 7f5f23e26d..a3c9927ee9 100644
--- a/lib/stdlib/src/pool.erl
+++ b/lib/stdlib/src/pool.erl
@@ -95,6 +95,9 @@ pspawn_link(M, F, A) ->
start_nodes([], _, _) -> [];
start_nodes([Host|Tail], Name, Args) ->
case slave:start(Host, Name, Args) of
+ {error, {already_running, Node}} ->
+ io:format("Can't start node on host ~w due to ~w~n",[Host, {already_running, Node}]),
+ [Node | start_nodes(Tail, Name, Args)];
{error, R} ->
io:format("Can't start node on host ~w due to ~w~n",[Host, R]),
start_nodes(Tail, Name, Args);
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 368dc2e3e5..4fd7f1d47c 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -138,7 +138,7 @@ delete_child(Supervisor, Name) ->
%%-----------------------------------------------------------------
-type term_err() :: 'not_found' | 'simple_one_for_one'.
--spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}.
+-spec terminate_child(sup_ref(), pid() | term()) -> 'ok' | {'error', term_err()}.
terminate_child(Supervisor, Name) ->
call(Supervisor, {terminate_child, Name}).
@@ -297,8 +297,26 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
{reply, What, State}
end;
-%%% The requests terminate_child, delete_child and restart_child are
-%%% invalid for simple_one_for_one supervisors.
+%% terminate_child for simple_one_for_one can only be done with pid
+handle_call({terminate_child, Name}, _From, State) when not is_pid(Name),
+ ?is_simple(State) ->
+ {reply, {error, simple_one_for_one}, State};
+
+handle_call({terminate_child, Name}, _From, State) ->
+ case get_child(Name, State, ?is_simple(State)) of
+ {value, Child} ->
+ case do_terminate(Child, State#state.name) of
+ #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) ->
+ {reply, ok, state_del_child(Child, State)};
+ NChild ->
+ {reply, ok, replace_child(NChild, State)}
+ end;
+ false ->
+ {reply, {error, not_found}, State}
+ end;
+
+%%% The requests delete_child and restart_child are invalid for
+%%% simple_one_for_one supervisors.
handle_call({_Req, _Data}, _From, State) when ?is_simple(State) ->
{reply, {error, simple_one_for_one}, State};
@@ -341,19 +359,6 @@ handle_call({delete_child, Name}, _From, State) ->
{reply, {error, not_found}, State}
end;
-handle_call({terminate_child, Name}, _From, State) ->
- case get_child(Name, State) of
- {value, Child} ->
- case do_terminate(Child, State#state.name) of
- #child{restart_type = temporary} = NChild ->
- {reply, ok, state_del_child(NChild, State)};
- NChild ->
- {reply, ok, replace_child(NChild, State)}
- end;
- _ ->
- {reply, {error, not_found}, State}
- end;
-
handle_call(which_children, _From, #state{children = [#child{restart_type = temporary,
child_type = CT,
modules = Mods}]} =
@@ -849,7 +854,28 @@ split_child(_, [], After) ->
{lists:reverse(After), []}.
get_child(Name, State) ->
+ get_child(Name, State, false).
+get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) ->
+ get_dynamic_child(Pid, State);
+get_child(Name, State, _) ->
lists:keysearch(Name, #child.name, State#state.children).
+
+get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) ->
+ case is_dynamic_pid(Pid, dynamics_db(Child#child.restart_type, Dynamics)) of
+ true ->
+ {value, Child#child{pid=Pid}};
+ false ->
+ case erlang:is_process_alive(Pid) of
+ true -> false;
+ false -> {value, Child}
+ end
+ end.
+
+is_dynamic_pid(Pid, Dynamics) when is_list(Dynamics) ->
+ lists:member(Pid, Dynamics);
+is_dynamic_pid(Pid, Dynamics) ->
+ dict:is_key(Pid, Dynamics).
+
replace_child(Child, State) ->
Chs = do_replace_child(Child, State#state.children),
State#state{children = Chs}.
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 9e3e717e7d..b3a7edc140 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -25,13 +25,14 @@
-export([start/1, add_handler/1, add_sup_handler/1,
delete_handler/1, swap_handler/1, swap_sup_handler/1,
notify/1, sync_notify/1, call/1, info/1, hibernate/1,
- call_format_status/1, error_format_status/1]).
+ call_format_status/1, call_format_status_anon/1,
+ error_format_status/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[start, {group, test_all}, hibernate,
- call_format_status, error_format_status].
+ call_format_status, call_format_status_anon, error_format_status].
groups() ->
[{test_all, [],
@@ -888,6 +889,22 @@ call_format_status(Config) when is_list(Config) ->
?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2,
ok.
+call_format_status_anon(suite) ->
+ [];
+call_format_status_anon(doc) ->
+ ["Test that sys:get_status/1,2 calls format_status/2 for anonymous gen_event processes"];
+call_format_status_anon(Config) when is_list(Config) ->
+ ?line {ok, Pid} = gen_event:start(),
+ %% The 'Name' of the gen_event process will be a pid() here, so
+ %% the next line will crash if format_status can't string-ify pids.
+ ?line Status1 = sys:get_status(Pid),
+ ?line ok = gen_event:stop(Pid),
+ Header = "Status for event handler " ++ pid_to_list(Pid),
+ ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1,
+ ?line Header = proplists:get_value(header, Data1),
+ ok.
+
+
error_format_status(suite) ->
[];
error_format_status(doc) ->
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index f9ceed8f84..cc271bd047 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -20,7 +20,7 @@
-module(supervisor_SUITE).
--include_lib("test_server/include/test_server.hrl").
+-include_lib("common_test/include/ct.hrl").
-define(TIMEOUT, 1000).
%% Testserver specific export
@@ -349,8 +349,7 @@ child_adm(Config) when is_list(Config) ->
ok = supervisor:terminate_child(sup_test, child1),
%% Start of already existing but not running process
- {error,already_present} =
- supervisor:start_child(sup_test, Child),
+ {error,already_present} = supervisor:start_child(sup_test, Child),
%% Restart
{ok, CPid2} = supervisor:restart_child(sup_test, child1),
@@ -377,6 +376,11 @@ child_adm(Config) when is_list(Config) ->
[{child1, CPid3, worker, []}] = supervisor:which_children(sup_test),
[1,1,0,1] = get_child_counts(sup_test),
+ %% Terminate with Pid not allowed when not simple_one_for_one
+ {error,not_found} = supervisor:terminate_child(sup_test, CPid3),
+ [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test),
+ [1,1,0,1] = get_child_counts(sup_test),
+
{'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}}
= (catch supervisor:which_children(foo)),
{'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}}
@@ -412,16 +416,26 @@ child_adm_simple(Config) when is_list(Config) ->
[1,2,0,2] = get_child_counts(sup_test),
%% Termination
- {error, simple_one_for_one} =
- supervisor:terminate_child(sup_test, child1),
+ {error, simple_one_for_one} = supervisor:terminate_child(sup_test, child1),
+ [1,2,0,2] = get_child_counts(sup_test),
+ ok = supervisor:terminate_child(sup_test,CPid1),
+ [_] = supervisor:which_children(sup_test),
+ [1,1,0,1] = get_child_counts(sup_test),
+ false = erlang:is_process_alive(CPid1),
+ %% Terminate non-existing proccess is ok
+ ok = supervisor:terminate_child(sup_test,CPid1),
+ [_] = supervisor:which_children(sup_test),
+ [1,1,0,1] = get_child_counts(sup_test),
+ %% Terminate pid which is not a child of this supervisor is not ok
+ NoChildPid = spawn_link(fun() -> receive after infinity -> ok end end),
+ {error, not_found} = supervisor:terminate_child(sup_test, NoChildPid),
+ true = erlang:is_process_alive(NoChildPid),
%% Restart
- {error, simple_one_for_one} =
- supervisor:restart_child(sup_test, child1),
+ {error, simple_one_for_one} = supervisor:restart_child(sup_test, child1),
%% Deletion
- {error, simple_one_for_one} =
- supervisor:delete_child(sup_test, child1),
+ {error, simple_one_for_one} = supervisor:delete_child(sup_test, child1),
ok.
%%-------------------------------------------------------------------------
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 7f0011bd68..591329b361 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -36,7 +36,7 @@
-export([capture_start/0,capture_stop/0,capture_get/0]).
-export([messages_get/0]).
-export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]).
--export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]).
+-export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1,timetrap_cancel/0]).
-export([m_out_of_n/3,do_times/4,do_times/2]).
-export([call_crash/3,call_crash/4,call_crash/5]).
-export([temp_name/1]).
@@ -1077,7 +1077,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
{{Time,Value},Loc,Opts} =
case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0],
- {ok, Args0}) of
+ {ok,Args0}) of
{ok,Args} ->
run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback);
Error = {error,_Reason} ->
@@ -1085,18 +1085,17 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit,
{skip,{failed,Error}}),
{{0,NewResult},{Mod,Func},[]};
{fail,Reason} ->
- [Conf] = Args0,
- Conf1 = [{tc_status,{failed,Reason}} | Conf],
+ Conf = [{tc_status,{failed,Reason}} | hd(Args0)],
fw_error_notify(Mod, Func, Conf, Reason),
- NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf1]},
- {fail, Reason}),
+ NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]},
+ {fail,Reason}),
{{0,NewResult},{Mod,Func},[]};
Skip = {skip,_Reason} ->
NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip),
{{0,NewResult},{Mod,Func},[]};
{auto_skip,Reason} ->
NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0},
- {skip, {fw_auto_skip,Reason}}),
+ {skip,{fw_auto_skip,Reason}}),
{{0,NewResult},{Mod,Func},[]}
end,
exit({Ref,Time,Value,Loc,Opts}).
@@ -1116,9 +1115,15 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
{skip_and_save,Reason,SaveCfg} ->
Line = get_loc(),
Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}],
- NewRes = do_end_tc_call(Mod, Func, {{skip, Reason}, [Conf]},
+ NewRes = do_end_tc_call(Mod, Func, {{skip,Reason},[Conf]},
{skip, Reason}),
{{0,NewRes},Line,[]};
+ FailTC = {fail,Reason} -> % user fails the testcase
+ EndConf = [{tc_status,{failed,Reason}} | hd(Args)],
+ fw_error_notify(Mod, Func, EndConf, Reason),
+ NewRes = do_end_tc_call(Mod, Func, {{error,Reason},[EndConf]},
+ FailTC),
+ {{0,NewRes},{Mod,Func},[]};
{ok,NewConf} ->
put(test_server_init_or_end_conf,undefined),
%% call user callback function if defined
@@ -1153,8 +1158,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
{FWReturn1,TSReturn1,EndConf2} =
case end_per_testcase(Mod, Func, EndConf1) of
SaveCfg1={save_config,_} ->
- {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config, 1, EndConf1)]};
- {fail,ReasonToFail} -> % user has failed the testcase
+ {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1,
+ EndConf1)]};
+ {fail,ReasonToFail} -> % user has failed the testcase
fw_error_notify(Mod, Func, EndConf1, ReasonToFail),
{{error,ReasonToFail},{failed,ReasonToFail},EndConf1};
{failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination
@@ -1193,11 +1199,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) ->
do_end_tc_call(M,F,Res,Return) ->
Ref = make_ref(),
- case test_server_sup:framework_call(
- end_tc, [?pl2a(M),F,Res], Ref) of
- {fail,FWReason} ->
- {failed,FWReason};
- Ref ->
+ case os:getenv("TEST_SERVER_FRAMEWORK") of
+ FW when FW == "ct_framework";
+ FW == "undefined";
+ FW == false ->
case test_server_sup:framework_call(
end_tc, [?pl2a(M),F,Res, Return], ok) of
{fail,FWReason} ->
@@ -1212,8 +1217,14 @@ do_end_tc_call(M,F,Res,Return) ->
NewReturn ->
NewReturn
end;
- _ ->
- Return
+ Other ->
+ case test_server_sup:framework_call(
+ end_tc, [Other,F,Res], Ref) of
+ {fail,FWReason} ->
+ {failed,FWReason};
+ _Else ->
+ Return
+ end
end.
%% the return value is a list and we have to check if it contains
@@ -1296,7 +1307,7 @@ init_per_testcase(Mod, Func, Args) ->
false -> code:load_file(Mod);
_ -> ok
end,
-%% init_per_testcase defined, returns new configuration
+ %% init_per_testcase defined, returns new configuration
case erlang:function_exported(Mod,init_per_testcase,2) of
true ->
case catch my_apply(Mod, init_per_testcase, [Func|Args]) of
@@ -1316,6 +1327,8 @@ init_per_testcase(Mod, Func, Args) ->
"bad elements in Config: ~p\n",[Bad]},
{skip,{failed,{Mod,init_per_testcase,bad_return}}}
end;
+ {'$test_server_ok',Res={fail,_Reason}} ->
+ Res;
{'$test_server_ok',_Other} ->
group_leader() ! {printout,12,
"ERROR! init_per_testcase did not return "
@@ -1690,7 +1703,7 @@ fail() ->
break(Comment) ->
case erase(test_server_timetraps) of
undefined -> ok;
- List -> lists:foreach(fun(Ref) -> timetrap_cancel(Ref) end,List)
+ List -> lists:foreach(fun({Ref,_}) -> timetrap_cancel(Ref) end, List)
end,
io:format(user,
"\n\n\n--- SEMIAUTOMATIC TESTING ---"
@@ -1771,14 +1784,16 @@ timetrap(Timeout0) ->
{undefined,false} -> timetrap1(Timeout, false);
{undefined,_} -> timetrap1(Timeout, true);
{infinity,_} -> infinity;
+ {_Int,_Scale} when Timeout == infinity -> infinity;
{Int,Scale} -> timetrap1(Timeout*Int, Scale)
end.
timetrap1(Timeout, Scale) ->
- Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,self()]),
+ TCPid = self(),
+ Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]),
case get(test_server_timetraps) of
- undefined -> put(test_server_timetraps,[Ref]);
- List -> put(test_server_timetraps,[Ref|List])
+ undefined -> put(test_server_timetraps,[{Ref,TCPid}]);
+ List -> put(test_server_timetraps,[{Ref,TCPid}|List])
end,
Ref.
@@ -1791,14 +1806,16 @@ ensure_timetrap(Config) ->
undefined -> ok;
Garbage ->
erase(test_server_default_timetrap),
- format("=== WARNING: garbage in test_server_default_timetrap: ~p~n",
+ format("=== WARNING: garbage in "
+ "test_server_default_timetrap: ~p~n",
[Garbage])
end,
DTmo = case lists:keysearch(default_timeout,1,Config) of
{value,{default_timeout,Tmo}} -> Tmo;
_ -> ?DEFAULT_TIMETRAP_SECS
end,
- format("=== test_server setting default timetrap of ~p seconds~n",
+ format("=== test_server setting default "
+ "timetrap of ~p seconds~n",
[DTmo]),
put(test_server_default_timetrap, timetrap(seconds(DTmo)))
end.
@@ -1810,11 +1827,13 @@ cancel_default_timetrap() ->
TimeTrap when is_pid(TimeTrap) ->
timetrap_cancel(TimeTrap),
erase(test_server_default_timetrap),
- format("=== test_server canceled default timetrap since another timetrap was set~n"),
+ format("=== test_server canceled default timetrap "
+ "since another timetrap was set~n"),
ok;
Garbage ->
erase(test_server_default_timetrap),
- format("=== WARNING: garbage in test_server_default_timetrap: ~p~n",
+ format("=== WARNING: garbage in "
+ "test_server_default_timetrap: ~p~n",
[Garbage]),
error
end.
@@ -1828,6 +1847,7 @@ time_ms({Other,_N}) ->
"Should be seconds, minutes, or hours.~n", [Other]),
exit({invalid_time_spec,Other});
time_ms(Ms) when is_integer(Ms) -> Ms;
+time_ms(infinity) -> infinity;
time_ms(Other) -> exit({invalid_time_spec,Other}).
@@ -1841,11 +1861,29 @@ timetrap_cancel(infinity) ->
timetrap_cancel(Handle) ->
case get(test_server_timetraps) of
undefined -> ok;
- [Handle] -> erase(test_server_timetraps);
- List -> put(test_server_timetraps,lists:delete(Handle,List))
+ [{Handle,_}] -> erase(test_server_timetraps);
+ Timers -> put(test_server_timetraps,
+ lists:keydelete(Handle, 1, Timers))
end,
test_server_sup:timetrap_cancel(Handle).
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% timetrap_cancel() -> ok
+%%
+%% Cancels timetrap for current test case.
+timetrap_cancel() ->
+ case get(test_server_timetraps) of
+ undefined ->
+ ok;
+ Timers ->
+ case lists:keysearch(self(), 2, Timers) of
+ {value,{Handle,_}} ->
+ timetrap_cancel(Handle);
+ _ ->
+ ok
+ end
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% hours(N) -> Milliseconds
%% minutes(N) -> Milliseconds
diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl
index 30d7314058..de9b962dfc 100644
--- a/lib/test_server/src/test_server_ctrl.erl
+++ b/lib/test_server/src/test_server_ctrl.erl
@@ -1812,6 +1812,9 @@ start_log_file() ->
ok = file:make_dir(PrivDir),
put(test_server_priv_dir,PrivDir++"/"),
print_timestamp(13,"Suite started at "),
+
+ LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir)}],
+ test_server_sup:framework_call(report, [loginfo,LogInfo]),
ok.
make_html_link(LinkName, Target, Explanation) ->
@@ -1925,7 +1928,6 @@ html_convert_modules(TestSpec, _Config) ->
copy_html_files(get(test_server_dir), get(test_server_log_dir_base)).
%% Retrieve a list of modules out of the test spec.
-
html_isolate_modules(List) -> html_isolate_modules(List, sets:new()).
html_isolate_modules([], Set) -> sets:to_list(Set);
@@ -1939,37 +1941,56 @@ html_isolate_modules([{Mod,_Case,_Args}|Cases], Set) ->
html_isolate_modules(Cases, sets:add_element(Mod, Set)).
%% Given a list of modules, convert each module's source code to HTML.
-
html_convert_modules([Mod|Mods]) ->
case code:which(Mod) of
Path when is_list(Path) ->
SrcFile = filename:rootname(Path) ++ ".erl",
- DestDir = get(test_server_dir),
- Name = atom_to_list(Mod),
- DestFile = filename:join(DestDir, downcase(Name) ++ ?src_listing_ext),
- html_possibly_convert(SrcFile, DestFile),
- html_convert_modules(Mods);
- _Other -> ok
+ FoundSrcFile =
+ case file:read_file_info(SrcFile) of
+ {ok,SInfo} ->
+ {SrcFile,SInfo};
+ {error,_} ->
+ ModInfo = Mod:module_info(compile),
+ case proplists:get_value(source, ModInfo) of
+ undefined ->
+ undefined;
+ OtherSrcFile ->
+ case file:read_file_info(OtherSrcFile) of
+ {ok,SInfo} ->
+ {OtherSrcFile,SInfo};
+ {error,_} ->
+ undefined
+ end
+ end
+ end,
+ case FoundSrcFile of
+ undefined ->
+ html_convert_modules(Mods);
+ {SrcFile1,SrcFileInfo} ->
+ DestDir = get(test_server_dir),
+ Name = atom_to_list(Mod),
+ DestFile = filename:join(DestDir,
+ downcase(Name)++?src_listing_ext),
+ html_possibly_convert(SrcFile1, SrcFileInfo, DestFile),
+ html_convert_modules(Mods)
+ end;
+ _Other ->
+ html_convert_modules(Mods)
end;
html_convert_modules([]) -> ok.
%% Convert source code to HTML if possible and needed.
-
-html_possibly_convert(Src, Dest) ->
- case file:read_file_info(Src) of
- {ok,SInfo} ->
- case file:read_file_info(Dest) of
- {error,_Reason} -> % no dest file
- erl2html2:convert(Src, Dest);
- {ok,DInfo} when DInfo#file_info.mtime < SInfo#file_info.mtime ->
- erl2html2:convert(Src, Dest);
- {ok,_DInfo} -> ok % dest file up to date
- end;
- {error,_Reason} -> ok % no source code found
+html_possibly_convert(Src, SrcInfo, Dest) ->
+ case file:read_file_info(Dest) of
+ {error,_Reason} -> % no dest file
+ erl2html2:convert(Src, Dest);
+ {ok,DestInfo} when DestInfo#file_info.mtime < SrcInfo#file_info.mtime ->
+ erl2html2:convert(Src, Dest);
+ {ok,_DestInfo} ->
+ ok % dest file up to date
end.
%% Copy all HTML files in InDir to OutDir.
-
copy_html_files(InDir, OutDir) ->
Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)),
lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files).
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 1a614d74d5..53dfb45e3a 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -83,13 +83,13 @@ timetrap(Timeout0, Scale, Pid) ->
%% Handle = term()
%%
%% Cancels a time trap.
-
timetrap_cancel(Handle) ->
unlink(Handle),
MonRef = erlang:monitor(process, Handle),
exit(Handle, kill),
receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end.
+
capture_get(Msgs) ->
receive
{captured,Msg} ->
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index 2ddffccf5b..8332ccfb40 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -22,6 +22,7 @@
-export([install/2, platform_id/1]).
-include("ts.hrl").
+-include_lib("kernel/include/file.hrl").
install(install_local, Options) ->
install(os:type(), Options);
@@ -150,11 +151,17 @@ add_vars(Vars0, Opts0) ->
end,
{PlatformId, PlatformLabel, PlatformFilename, Version} =
platform([{longnames, LongNames}|Vars0]),
+ NetDir = lists:concat(["/net", hostname()]),
+ Mounted = case file:read_file_info(NetDir) of
+ {ok, #file_info{type = directory}} -> NetDir;
+ _ -> ""
+ end,
{Opts, [{longnames, LongNames},
{platform_id, PlatformId},
{platform_filename, PlatformFilename},
{rsh_name, get_rsh_name()},
{platform_label, PlatformLabel},
+ {ts_net_dir, Mounted},
{erl_flags, []},
{erl_release, Version},
{ts_testcase_callback, get_testcase_callback()} | Vars0]}.
diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl
index 067961a216..d145290820 100644
--- a/lib/test_server/src/ts_run.erl
+++ b/lib/test_server/src/ts_run.erl
@@ -212,6 +212,12 @@ make_command(Vars, Spec, State) ->
false ->
ok
end,
+
+ %% If Common Test specific variables are needed, add them here
+ %% on form: "{key1,value1}" "{key2,value2}" ...
+ NetDir = ts_lib:var(ts_net_dir, Vars),
+ TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ],
+
%% NOTE: Do not use ' in these commands as it wont work on windows
Cmd = [Erl, Naming, "test_server"
" -rsh ", ts_lib:var(rsh_name, Vars),
@@ -224,6 +230,7 @@ make_command(Vars, Spec, State) ->
%% " -test_server_format_exception false",
" -boot start_sasl -sasl errlog_type error",
" -pz ",Cwd,
+ " -ct_test_vars ",TestVars,
" -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" "
" -eval \"ct:run_test(",
backslashify(lists:flatten(State#state.test_server_args)),")\""
@@ -369,7 +376,6 @@ make_common_test_args(Args0, Options, _Vars) ->
end,
ConfigFiles = [{config,[filename:join(ConfigPath,File)
|| File <- get_config_files()]}],
-
io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++
ConfigFiles++Options]).
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index e1c0d31371..6728bef2a4 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -386,7 +386,8 @@ then no prototype is inserted.
The test is performed by the function `erlang-test-criteria-list'.")
(defvar erlang-electric-arrow-criteria
- '(erlang-next-lines-empty-p
+ '(erlang-stop-when-in-type-spec
+ erlang-next-lines-empty-p
erlang-at-end-of-function-p)
"*List of functions controlling the arrow aspect of `erlang-electric-gt'.
The functions in this list are called, in order, whenever a `>'
@@ -4045,6 +4046,16 @@ This function is designed to be a member of a criteria list."
nil)))
+(defun erlang-stop-when-in-type-spec ()
+ "Return `stop' when in a type spec line.
+
+This function is designed to be a member of a criteria list."
+ (save-excursion
+ (beginning-of-line)
+ (when (save-match-data (looking-at "-\\(spec\\|type\\)"))
+ 'stop)))
+
+
(defun erlang-next-lines-empty-p ()
"Return non-nil if next lines are empty.
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 230f0e9428..73a736f0e8 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -253,6 +253,7 @@ compile_modules(Files,Options) ->
{i, Dir} when is_list(Dir) -> true;
{d, _Macro} -> true;
{d, _Macro, _Value} -> true;
+ export_all -> true;
_ -> false
end
end,
@@ -625,7 +626,7 @@ main_process_loop(State) ->
case get_beam_file(Module,BeamFile0,Compiled0) of
{ok,BeamFile} ->
{Reply,Compiled} =
- case do_compile_beam(Module,BeamFile) of
+ case do_compile_beam(Module,BeamFile,[]) of
{ok, Module} ->
remote_load_compiled(State#main_state.nodes,
[{Module,BeamFile}]),
@@ -1258,13 +1259,13 @@ do_compile(File, UserOptions) ->
Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions,
case compile:file(File, Options) of
{ok, Module, Binary} ->
- do_compile_beam(Module,Binary);
+ do_compile_beam(Module,Binary,UserOptions);
error ->
error
end.
%% Beam is a binary or a .beam file name
-do_compile_beam(Module,Beam) ->
+do_compile_beam(Module,Beam,UserOptions) ->
%% Clear database
do_clear(Module),
@@ -1284,7 +1285,7 @@ do_compile_beam(Module,Beam) ->
%% Compile and load the result
%% It's necessary to check the result of loading since it may
%% fail, for example if Module resides in a sticky directory
- {ok, Module, Binary} = compile:forms(Forms, []),
+ {ok, Module, Binary} = compile:forms(Forms, UserOptions),
case code:load_binary(Module, ?TAG, Binary) of
{module, Module} ->
diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml
index 067fd31961..2748f21bbe 100644
--- a/system/doc/design_principles/sup_princ.xml
+++ b/system/doc/design_principles/sup_princ.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>1997</year><year>2009</year>
+ <year>1997</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -335,6 +335,12 @@ supervisor:start_child(Pid, [id1])</code>
<c>apply(call, start_link, []++[id1])</c>, or actually:</p>
<code type="none">
call:start_link(id1)</code>
+ <p>A child under a <c>simple_one_for_one</c> supervisor can be terminated
+ with</p>
+ <code type="none">
+supervisor:terminate_child(Sup, Pid)</code>
+ <p>where <c>Sup</c> is the pid, or name, of the supervisor and
+ <c>Pid</c> is the pid of the child.</p>
</section>
<section>