aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/doc/src/erl_nif.xml215
-rw-r--r--erts/emulator/beam/bif.c4
-rw-r--r--erts/emulator/beam/break.c61
-rw-r--r--erts/emulator/beam/dist.c25
-rw-r--r--erts/emulator/beam/erl_alloc.c2
-rw-r--r--erts/emulator/beam/erl_alloc.types1
-rw-r--r--erts/emulator/beam/erl_bif_info.c90
-rw-r--r--erts/emulator/beam/erl_binary.h8
-rw-r--r--erts/emulator/beam/erl_bits.c3
-rw-r--r--erts/emulator/beam/erl_driver.h16
-rw-r--r--erts/emulator/beam/erl_drv_nif.h15
-rw-r--r--erts/emulator/beam/erl_lock_check.c3
-rw-r--r--erts/emulator/beam/erl_monitors.c47
-rw-r--r--erts/emulator/beam/erl_monitors.h19
-rw-r--r--erts/emulator/beam/erl_nif.c512
-rw-r--r--erts/emulator/beam/erl_nif.h35
-rw-r--r--erts/emulator/beam/erl_nif_api_funcs.h10
-rw-r--r--erts/emulator/beam/erl_node_tables.c4
-rw-r--r--erts/emulator/beam/erl_process.c50
-rw-r--r--erts/emulator/beam/erl_time_sup.c2
-rw-r--r--erts/emulator/beam/global.h48
-rw-r--r--erts/emulator/beam/io.c34
-rw-r--r--erts/emulator/sys/common/erl_check_io.c963
-rw-r--r--erts/emulator/sys/common/erl_check_io.h18
-rw-r--r--erts/emulator/sys/unix/sys.c10
-rw-r--r--erts/emulator/test/erl_link_SUITE.erl4
-rw-r--r--erts/emulator/test/nif_SUITE.erl427
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_SUITE.c845
-rw-r--r--erts/emulator/test/nif_SUITE_data/nif_mod.c2
-rw-r--r--lib/common_test/doc/src/Makefile3
-rw-r--r--lib/common_test/doc/src/ct_testspec.xml84
-rw-r--r--lib/common_test/doc/src/ref_man.xml1
-rw-r--r--lib/common_test/src/ct_testspec.erl28
-rw-r--r--lib/common_test/test/ct_testspec_2_SUITE.erl82
-rw-r--r--lib/kernel/src/os.erl24
-rw-r--r--lib/kernel/test/code_SUITE.erl36
-rw-r--r--lib/ssl/doc/src/ssl_session_cache_api.xml29
-rw-r--r--lib/ssl/src/tls_v1.erl18
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl131
-rw-r--r--lib/stdlib/src/sofs.erl357
-rw-r--r--lib/stdlib/test/io_SUITE.erl241
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.erl33
-rw-r--r--lib/xmerl/src/xmerl_sax_parser.hrl9
-rw-r--r--lib/xmerl/src/xmerl_sax_parser_base.erlsrc84
-rw-r--r--lib/xmerl/test/Makefile4
-rw-r--r--lib/xmerl/test/xmerl_sax_SUITE.erl6
-rw-r--r--lib/xmerl/test/xmerl_sax_std_SUITE.erl100
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE.erl245
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml17
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml18
-rw-r--r--lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml34
52 files changed, 4256 insertions, 810 deletions
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 74a551d60b..b0a632d2d6 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -675,6 +675,18 @@ typedef struct {
<p>When receiving data from untrusted sources, use option
<c>ERL_NIF_BIN2TERM_SAFE</c>.</p>
</item>
+ <tag><marker id="ErlNifMonitor"/><c>ErlNifMonitor</c></tag>
+ <item>
+ <p>This is an opaque data type that identifies a monitor.</p>
+ <p>The nif writer is to provide the memory for storing the
+ monitor when calling <seealso marker="#enif_monitor_process">
+ <c>enif_monitor_process</c></seealso>. The
+ address of the data is not stored by the runtime system, so
+ <c>ErlNifMonitor</c> can be used as any other data, it
+ can be copied, moved in memory, forgotten, and so on.
+ To compare two monitors, <seealso marker="#enif_compare_monitors">
+ <c>enif_compare_monitors</c></seealso> must be used.</p>
+ </item>
<tag><marker id="ErlNifPid"/><c>ErlNifPid</c></tag>
<item>
<p>A process identifier (pid). In contrast to pid terms (instances of
@@ -696,11 +708,46 @@ typedef struct {
Each resource type has a unique name and a destructor function that
is called when objects of its type are released.</p>
</item>
+ <tag><marker id="ErlNifResourceTypeInit"/><c>ErlNifResourceTypeInit</c></tag>
+ <item>
+ <code type="none">
+typedef struct {
+ ErlNifResourceDtor* dtor;
+ ErlNifResourceStop* stop;
+} ErlNifResourceTypeInit;</code>
+ <p>Initialization structure read by <seealso marker="#enif_open_resource_type_x">
+ enif_open_resource_type_x</seealso>.</p>
+ </item>
<tag><marker id="ErlNifResourceDtor"/><c>ErlNifResourceDtor</c></tag>
<item>
<code type="none">
typedef void ErlNifResourceDtor(ErlNifEnv* env, void* obj);</code>
<p>The function prototype of a resource destructor function.</p>
+ <p>The <c>obj</c> argument is a pointer to the resource. The only
+ allowed use for the resource in the destructor is to access its
+ user data one final time. The destructor is guaranteed to be the
+ last callback before the resource is deallocated.</p>
+ </item>
+ <tag><marker id="ErlNifResourceDown"/><c>ErlNifResourceDown</c></tag>
+ <item>
+ <code type="none">
+typedef void ErlNifResourceDown(ErlNifEnv* env, void* obj, const ErlNifPid* pid, const ErlNifMonitor* mon);</code>
+ <p>The function prototype of a resource down function,
+ called on the behalf of <seealso marker="#enif_monitor_process">
+ enif_monitor_process</seealso>. <c>obj</c> is the resource, <c>pid</c>
+ is the identity of the monitored process that is exiting, and <c>mon</c>
+ is the identity of the monitor.
+ </p>
+ </item>
+ <tag><marker id="ErlNifResourceStop"/><c>ErlNifResourceStop</c></tag>
+ <item>
+ <code type="none">
+typedef void ErlNifResourceStop(ErlNifEnv* env, void* obj, ErlNifEvent event, int is_direct_call);</code>
+ <p>The function prototype of a resource stop function,
+ called on the behalf of <seealso marker="#enif_select">
+ enif_select</seealso>. <c>obj</c> is the resource, <c>event</c> is OS event,
+ <c>is_direct_call</c> is true if the call is made directly from <c>enif_select</c>
+ or false if it is a scheduled call (potentially from another thread).</p>
</item>
<tag><marker id="ErlNifCharEncoding"/><c>ErlNifCharEncoding</c></tag>
<item>
@@ -875,6 +922,21 @@ typedef enum {
</func>
<func>
+ <name><ret>int</ret><nametext>enif_compare_monitors(const ErlNifMonitor
+ *monitor1, const ErlNifMonitor *monitor2)</nametext></name>
+ <fsummary>Compare two monitors.</fsummary>
+ <desc>
+ <marker id="enif_compare_monitors"></marker>
+ <p>Compares two <seealso marker="#ErlNifMonitor"><c>ErlNifMonitor</c></seealso>s.
+ Can also be used to imply some artificial order on monitors,
+ for whatever reason.</p>
+ <p>Returns <c>0</c> if <c>monitor1</c> and <c>monitor2</c> are equal,
+ &lt; <c>0</c> if <c>monitor1</c> &lt; <c>monitor2</c>, and
+ &gt; <c>0</c> if <c>monitor1</c> &gt; <c>monitor2</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>void</ret>
<nametext>enif_cond_broadcast(ErlNifCond *cnd)</nametext></name>
<fsummary></fsummary>
@@ -1002,6 +1064,30 @@ typedef enum {
</func>
<func>
+ <name><ret>int</ret><nametext>enif_demonitor_process(ErlNifEnv* env, void* obj,
+ const ErlNifMonitor* mon)</nametext></name>
+ <fsummary>Cancel a process monitor.</fsummary>
+ <desc>
+ <marker id="enif_demonitor_process"></marker>
+ <p>Cancels a monitor created earlier with <seealso marker="#enif_monitor_process">
+ <c>enif_monitor_process</c></seealso>. Argument <c>obj</c> is a pointer
+ to the resource holding the monitor and <c>*mon</c> identifies the monitor.</p>
+ <p>Returns <c>0</c> if the monitor was successfully identified and removed.
+ Returns a non-zero value if the monitor could not be identified, which means
+ it was either</p>
+ <list type="bulleted">
+ <item>never created for this resource</item>
+ <item>already cancelled</item>
+ <item>already triggered</item>
+ <item>just about to be triggered by a concurrent thread</item>
+ </list>
+ <p>This function is only thread-safe when the emulator with SMP support
+ is used. It can only be used in a non-SMP emulator from a NIF-calling
+ thread.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret>
<nametext>enif_equal_tids(ErlNifTid tid1, ErlNifTid tid2)</nametext>
</name>
@@ -2117,6 +2203,36 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>int</ret><nametext>enif_monitor_process(ErlNifEnv* env, void* obj,
+ const ErlNifPid* target_pid, ErlNifMonitor* mon)</nametext></name>
+ <fsummary>Monitor a process from a resource.</fsummary>
+ <desc>
+ <marker id="enif_monitor_process"></marker>
+ <p>Starts monitoring a process from a resource. When a process is
+ monitored, a process exit results in a call to the provided
+ <seealso marker="#ErlNifResourceDown">
+ <c>down</c></seealso> callback associated with the resource type.</p>
+ <p>Argument <c>obj</c> is pointer to the resource to hold the monitor and
+ <c>*target_pid</c> identifies the local process to be monitored.</p>
+ <p>If <c>mon</c> is not <c>NULL</c>, a successful call stores the
+ identity of the monitor in the
+ <seealso marker="#ErlNifMonitor"><c>ErlNifMonitor</c></seealso>
+ struct pointed to by <c>mon</c>. This identifier is used to refer to the
+ monitor for later removal with
+ <seealso marker="#enif_demonitor_process"><c>enif_demonitor_process</c></seealso>
+ or compare with
+ <seealso marker="#enif_compare_monitors"><c>enif_compare_monitors</c></seealso>.
+ A monitor is automatically removed when it triggers or when
+ the resource is deallocated.</p>
+ <p>Returns <c>0</c> on success, &lt; 0 if no <c>down</c> callback is
+ provided, and &gt; 0 if the process is no longer alive.</p>
+ <p>This function is only thread-safe when the emulator with SMP support
+ is used. It can only be used in a non-SMP emulator from a NIF-calling
+ thread.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>ErlNifTime</ret>
<nametext>enif_monotonic_time(ErlNifTimeUnit time_unit)</nametext>
</name>
@@ -2236,6 +2352,24 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>ErlNifResourceType *</ret>
+ <nametext>enif_open_resource_type_x(ErlNifEnv* env, const char* name,
+ ErlNifResourceTypeInit* init,
+ ErlNifResourceFlags flags, ErlNifResourceFlags* tried)</nametext>
+ </name>
+ <fsummary>Create or takeover a resource type.</fsummary>
+ <desc>
+ <p>Same as <seealso marker="#enif_open_resource_type"><c>enif_open_resource_type</c></seealso>
+ except is also accept a <c>stop</c> callback for resource types that are
+ used together with <seealso marker="#enif_select"><c>enif_select</c></seealso>.</p>
+ <p>Argument <c>init</c> is a pointer to an
+ <seealso marker="#ErlNifResourceTypeInit"><c>ErlNifResourceTypeInit</c></seealso>
+ structure that contains the function pointers for destructor, down and stop callbacks
+ for the resource type.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret><nametext>enif_port_command(ErlNifEnv* env, const
ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg)</nametext>
</name>
@@ -2342,7 +2476,7 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
<nametext>enif_release_resource(void* obj)</nametext></name>
<fsummary>Release a resource object.</fsummary>
<desc>
- <p>Removes a reference to resource object <c>obj</c>obtained from
+ <p>Removes a reference to resource object <c>obj</c> obtained from
<seealso marker="#enif_alloc_resource">
<c>enif_alloc_resource</c></seealso>.
The resource object is destructed when the last reference is removed.
@@ -2482,6 +2616,85 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>int</ret>
+ <nametext>enif_select(ErlNifEnv* env, ErlNifEvent event, enum ErlNifSelectFlags mode,
+ void* obj, const ErlNifPid* pid, ERL_NIF_TERM ref)</nametext>
+ </name>
+ <fsummary>Manage subscription on IO event.</fsummary>
+ <desc>
+ <p>This function can be used to receive asynchronous notifications
+ when OS-specific event objects become ready for either read or write operations.</p>
+ <p>Argument <c>event</c> identifies the event object. On Unix
+ systems, the functions <c>select</c>/<c>poll</c> are used. The event
+ object must be a socket, pipe or other file descriptor object that
+ <c>select</c>/<c>poll</c> can use.</p>
+ <p>Argument <c>mode</c> describes the type of events to wait for. It can be
+ <c>ERL_NIF_SELECT_READ</c>, <c>ERL_NIF_SELECT_WRITE</c> or a bitwise
+ OR combination to wait for both. It can also be <c>ERL_NIF_SELECT_STOP</c>
+ which is described further below. When a read or write event is triggerred,
+ a notification message like this is sent to the process identified by
+ <c>pid</c>:</p>
+ <code type="none"><c>{select, Obj, Ref, ready_input | ready_output}</c></code>
+ <p><c>ready_input</c> or <c>ready_output</c> indicates if the event object
+ is ready for reading or writing.</p>
+ <p>Argument <c>pid</c> may be <c>NULL</c> to indicate the calling process.</p>
+ <p>Argument <c>obj</c> is a resource object obtained from
+ <seealso marker="#enif_alloc_resource"><c>enif_alloc_resource</c></seealso>.
+ The purpose of the resource objects is as a container of the event object
+ to manage its state and lifetime. A handle to the resource is received
+ in the notification message as <c>Obj</c>.</p>
+ <p>Argument <c>ref</c> must be either a reference obtained from
+ <seealso marker="erlang#make_ref-0"><c>erlang:make_ref/0</c></seealso>
+ or the atom <c>undefined</c>. It will be passed as <c>Ref</c> in the notifications.
+ If a selective <c>receive</c> statement is used to wait for the notification
+ then a reference created just before the <c>receive</c> will exploit a runtime
+ optimization that bypasses all earlier received messages in the queue.</p>
+ <p>The notifications are one-shot only. To receive further notifications of the same
+ type (read or write), repeated calls to <c>enif_select</c> must be made
+ after receiving each notification.</p>
+ <p>Use <c>ERL_NIF_SELECT_STOP</c> as <c>mode</c> in order to safely
+ close an event object that has been passed to <c>enif_select</c>. The
+ <seealso marker="#ErlNifResourceStop"><c>stop</c></seealso> callback
+ of the resource <c>obj</c> will be called when it is safe to close
+ the event object. This safe way of closing event objects must be used
+ even if all notifications have been received and no further calls to
+ <c>enif_select</c> have been made.</p>
+ <p>Returns a non-negative value on success where the following bits can be set:</p>
+ <taglist>
+ <tag><c>ERL_NIF_SELECT_STOP_CALLED</c></tag>
+ <item>The stop callback was called directly by <c>enif_select</c>.</item>
+ <tag><c>ERL_NIF_SELECT_STOP_SCHEDULED</c></tag>
+ <item>The stop callback was scheduled to run on some other thread
+ or later by this thread.</item>
+ </taglist>
+ <p>Returns a negative value if the call failed where the follwing bits can be set:</p>
+ <taglist>
+ <tag><c>ERL_NIF_SELECT_INVALID_EVENT</c></tag>
+ <item>Argument <c>event</c> is not a valid OS event object.</item>
+ <tag><c>ERL_NIF_SELECT_FAILED</c></tag>
+ <item>The system call failed to add the event object to the poll set.</item>
+ </taglist>
+ <note>
+ <p>Use bitwise AND to test for specific bits in the return vaue.
+ New significant bits may be added in future releases to give more detailed
+ information for both failed and successful calls. Do NOT use equallity tests
+ like <c>==</c>, as that may cause your application to stop working.</p>
+ <p>Example:</p>
+ <code type="none">
+retval = enif_select(env, fd, ERL_NIF_SELECT_STOP, resource, ref);
+if (retval &lt; 0) {
+ /* handle error */
+}
+/* Success! */
+if (retval &amp; ERL_NIF_SELECT_STOP_CALLED) {
+ /* ... */
+}
+</code>
+ </note>
+ </desc>
+ </func>
+
+ <func>
<name><ret>ErlNifPid *</ret>
<nametext>enif_self(ErlNifEnv* caller_env, ErlNifPid* pid)</nametext>
</name>
diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c
index 4c9b9887c1..614bedab12 100644
--- a/erts/emulator/beam/bif.c
+++ b/erts/emulator/beam/bif.c
@@ -361,7 +361,7 @@ remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to)
c_p->common.id,
(mon->name != NIL
? mon->name
- : mon->pid),
+ : mon->u.pid),
ref,
0);
res = (code == ERTS_DSIG_SEND_YIELD ? am_yield : am_true);
@@ -498,7 +498,7 @@ BIF_RETTYPE demonitor(Process *c_p, Eterm ref, Eterm *multip)
res = am_true;
break;
case MON_ORIGIN:
- to = mon->pid;
+ to = mon->u.pid;
*multip = am_false;
if (is_atom(to)) {
/* Monitoring a name at node to */
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index aaed094af9..4dad5736c5 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -178,19 +178,28 @@ static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext)
prefix = "";
}
- if (mon->type == MON_ORIGIN) {
- if (is_atom(mon->pid)) { /* dist by name */
- ASSERT(is_node_name_atom(mon->pid));
+ switch (mon->type) {
+ case MON_ORIGIN:
+ if (is_atom(mon->u.pid)) { /* dist by name */
+ ASSERT(is_node_name_atom(mon->u.pid));
erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
- mon->pid, mon->ref);
+ mon->u.pid, mon->ref);
} else if (is_atom(mon->name)){ /* local by name */
erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name,
erts_this_dist_entry->sysname, mon->ref);
} else { /* local and distributed by pid */
- erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->pid, mon->ref);
+ erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->u.pid, mon->ref);
}
- } else { /* MON_TARGET */
- erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->pid, mon->ref);
+ break;
+ case MON_TARGET:
+ erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->u.pid, mon->ref);
+ break;
+ case MON_NIF_TARGET: {
+ ErtsResource* rsrc = mon->u.resource;
+ erts_print(to, to_arg, "%s{from,{%T,%T},%T}", prefix, rsrc->type->module,
+ rsrc->type->name, mon->ref);
+ break;
+ }
}
}
@@ -381,10 +390,12 @@ info(fmtfn_t to, void *to_arg)
static int code_size(struct erl_module_instance* modi)
{
- ErtsLiteralArea* lit = modi->code_hdr->literal_area;
int size = modi->code_length;
- if (lit) {
- size += (lit->end - lit->start) * sizeof(Eterm);
+
+ if (modi->code_hdr) {
+ ErtsLiteralArea* lit = modi->code_hdr->literal_area;
+ if (lit)
+ size += (lit->end - lit->start) * sizeof(Eterm);
}
return size;
}
@@ -406,13 +417,9 @@ loaded(fmtfn_t to, void *to_arg)
* Calculate and print totals.
*/
for (i = 0; i < module_code_size(code_ix); i++) {
- if ((modp = module_code(i, code_ix)) != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
+ if ((modp = module_code(i, code_ix)) != NULL) {
cur += code_size(&modp->curr);
- if (modp->old.code_length != 0) {
- old += code_size(&modp->old);
- }
+ old += code_size(&modp->old);
}
}
erts_print(to, to_arg, "Current code: %d\n", cur);
@@ -428,26 +435,20 @@ loaded(fmtfn_t to, void *to_arg)
/*
* Interactive dump; keep it brief.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
- erts_print(to, to_arg, "%T", make_atom(modp->module));
- cur += code_size(&modp->curr);
- erts_print(to, to_arg, " %d", code_size(&modp->curr));
- if (modp->old.code_length != 0) {
- erts_print(to, to_arg, " (%d old)",
- code_size(&modp->old));
- old += code_size(&modp->old);
- }
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
+ erts_print(to, to_arg, "%T %d", make_atom(modp->module),
+ code_size(&modp->curr));
+ if (modp->old.code_length != 0)
+ erts_print(to, to_arg, " (%d old)", code_size(&modp->old));
erts_print(to, to_arg, "\n");
}
} else {
/*
* To crash dump; make it parseable.
*/
- if (modp != NULL &&
- ((modp->curr.code_length != 0) ||
- (modp->old.code_length != 0))) {
+ if (modp != NULL && ((modp->curr.code_length != 0) ||
+ (modp->old.code_length != 0))) {
erts_print(to, to_arg, "=mod:");
erts_print(to, to_arg, "%T", make_atom(modp->module));
erts_print(to, to_arg, "\n");
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index e659ac071c..d1c2da9074 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -259,7 +259,7 @@ static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp)
DistEntry *dep = ((NetExitsContext *) vnecp)->dep;
ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK;
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
if (!rp)
goto done;
@@ -278,10 +278,11 @@ static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp)
rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
/* ASSERT(rmon != NULL); can happen during process exit */
if (rmon != NULL) {
+ ASSERT(rmon->type == MON_ORIGIN);
ASSERT(is_atom(rmon->name) || is_nil(rmon->name));
watched = (is_atom(rmon->name)
? TUPLE2(lhp, rmon->name, dep->sysname)
- : rmon->pid);
+ : rmon->u.pid);
#ifdef ERTS_SMP
rp_locks |= ERTS_PROC_LOCKS_MSG_SEND;
erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_MSG_SEND);
@@ -1391,7 +1392,7 @@ int erts_net_message(Port *prt,
if (mon == NULL) {
break;
}
- watched = mon->pid;
+ watched = mon->u.pid;
erts_destroy_monitor(mon);
rp = erts_pid2proc_opt(NULL, 0,
watched, ERTS_PROC_LOCK_LINK,
@@ -1549,7 +1550,7 @@ int erts_net_message(Port *prt,
if (mon == NULL) {
break;
}
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
erts_destroy_monitor(mon);
if (rp == NULL) {
@@ -1566,7 +1567,7 @@ int erts_net_message(Port *prt,
watched = (is_not_nil(mon->name)
? TUPLE2(&lhp[0], mon->name, sysname)
- : mon->pid);
+ : mon->u.pid);
erts_queue_monitor_message(rp, &rp_locks,
ref, am_process, watched, reason);
@@ -2415,21 +2416,21 @@ static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp)
void *arg = ((struct print_to_data *) vptdp)->arg;
Process *rp;
ErtsMonitor *rmon;
- rp = erts_proc_lookup(mon->pid);
+ rp = erts_proc_lookup(mon->u.pid);
if (!rp || (rmon = erts_lookup_monitor(ERTS_P_MONITORS(rp), mon->ref)) == NULL) {
- erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->pid);
+ erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->u.pid);
} else if (mon->type == MON_ORIGIN) {
/* Local pid is being monitored */
erts_print(to, arg, "Remotely monitored by: %T %T\n",
- mon->pid, rmon->pid);
+ mon->u.pid, rmon->u.pid);
} else {
- erts_print(to, arg, "Remote monitoring: %T ", mon->pid);
- if (is_not_atom(rmon->pid))
- erts_print(to, arg, "%T\n", rmon->pid);
+ erts_print(to, arg, "Remote monitoring: %T ", mon->u.pid);
+ if (is_not_atom(rmon->u.pid))
+ erts_print(to, arg, "%T\n", rmon->u.pid);
else
erts_print(to, arg, "{%T, %T}\n",
rmon->name,
- rmon->pid); /* which in this case is the
+ rmon->u.pid); /* which in this case is the
remote system name... */
}
}
diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c
index 6708d96d56..a374593c5d 100644
--- a/erts/emulator/beam/erl_alloc.c
+++ b/erts/emulator/beam/erl_alloc.c
@@ -664,6 +664,8 @@ erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop)
= sizeof(ErtsDrvEventDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_DRV_SEL_D_STATE)]
= sizeof(ErtsDrvSelectDataState);
+ fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_NIF_SEL_D_STATE)]
+ = sizeof(ErtsNifSelectDataState);
fix_type_sizes[ERTS_ALC_FIX_TYPE_IX(ERTS_ALC_T_MSG_REF)]
= sizeof(ErtsMessageRef);
#ifdef ERTS_SMP
diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types
index 295db2fe9b..3d5de72ee7 100644
--- a/erts/emulator/beam/erl_alloc.types
+++ b/erts/emulator/beam/erl_alloc.types
@@ -402,6 +402,7 @@ type DRV_TAB LONG_LIVED SYSTEM drv_tab
type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state
type DRV_EV_D_STATE FIXED_SIZE SYSTEM driver_event_data_state
type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state
+type NIF_SEL_D_STATE FIXED_SIZE SYSTEM enif_select_data_state
type FD_LIST SHORT_LIVED SYSTEM fd_list
type ACTIVE_FD_ARR SHORT_LIVED SYSTEM active_fd_array
type POLLSET LONG_LIVED SYSTEM pollset
diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c
index 5a8776076e..06a73ffea5 100644
--- a/erts/emulator/beam/erl_bif_info.c
+++ b/erts/emulator/beam/erl_bif_info.c
@@ -228,8 +228,10 @@ bld_magic_ref_bin_list(Uint **hpp, Uint *szp, ErlOffHeap* oh)
static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz)
{
Uint *psz = vpsz;
- *psz += IS_CONST(mon->ref) ? 0 : NC_HEAP_SIZE(mon->ref);
- *psz += IS_CONST(mon->pid) ? 0 : NC_HEAP_SIZE(mon->pid);
+ *psz += NC_HEAP_SIZE(mon->ref);
+ *psz += (mon->type == MON_NIF_TARGET ?
+ erts_resource_ref_size(mon->u.resource) :
+ (is_immed(mon->u.pid) ? 0 : NC_HEAP_SIZE(mon->u.pid)));
*psz += 8; /* CONS + 5-tuple */
}
@@ -244,12 +246,11 @@ static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc)
{
MonListContext *pmlc = vpmlc;
Eterm tup;
- Eterm r = (IS_CONST(mon->ref)
- ? mon->ref
- : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref));
- Eterm p = (IS_CONST(mon->pid)
- ? mon->pid
- : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->pid));
+ Eterm r = STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->ref);
+ Eterm p = (mon->type == MON_NIF_TARGET ?
+ erts_bld_resource_ref(&(pmlc->hp), &MSO(pmlc->p), mon->u.resource)
+ : (is_immed(mon->u.pid) ? mon->u.pid
+ : STORE_NC(&(pmlc->hp), &MSO(pmlc->p), mon->u.pid)));
tup = TUPLE5(pmlc->hp, pmlc->tag, make_small(mon->type), r, p, mon->name);
pmlc->hp += 6;
pmlc->res = CONS(pmlc->hp, tup, pmlc->res);
@@ -288,7 +289,7 @@ make_monitor_list(Process *p, ErtsMonitor *root)
static void do_calc_lnk_size(ErtsLink *lnk, void *vpsz)
{
Uint *psz = vpsz;
- *psz += IS_CONST(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
+ *psz += is_immed(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid);
if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
/* Node links use this pointer as ref counter... */
erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_calc_lnk_size,vpsz);
@@ -308,7 +309,7 @@ static void do_make_one_lnk_element(ErtsLink *lnk, void * vpllc)
LnkListContext *pllc = vpllc;
Eterm tup;
Eterm old_res, targets = NIL;
- Eterm p = (IS_CONST(lnk->pid)
+ Eterm p = (is_immed(lnk->pid)
? lnk->pid
: STORE_NC(&(pllc->hp), &MSO(pllc->p), lnk->pid));
if (lnk->type == LINK_NODE) {
@@ -392,8 +393,12 @@ erts_print_system_version(fmtfn_t to, void *arg, Process *c_p)
typedef struct {
/* {Entity,Node} = {monitor.Name,monitor.Pid} for external by name
* {Entity,Node} = {monitor.Pid,NIL} for external/external by pid
- * {Entity,Node} = {monitor.Name,erlang:node()} for internal by name */
- Eterm entity;
+ * {Entity,Node} = {monitor.Name,erlang:node()} for internal by name
+ * {Entity,Node} = {monitor.resource,MON_NIF_TARGET}*/
+ union {
+ Eterm term;
+ ErtsResource* resource;
+ }entity;
Eterm node;
/* pid is actual target being monitored, no matter pid/port or name */
Eterm pid;
@@ -439,7 +444,7 @@ static void collect_one_link(ErtsLink *lnk, void *vmicp)
if (!(lnk->type == LINK_PID)) {
return;
}
- micp->mi[micp->mi_i].entity = lnk->pid;
+ micp->mi[micp->mi_i].entity.term = lnk->pid;
micp->sz += 2 + NC_HEAP_SIZE(lnk->pid);
micp->mi_i++;
}
@@ -452,20 +457,20 @@ static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
return;
}
EXTEND_MONITOR_INFOS(micp);
- if (is_atom(mon->pid)) { /* external by name */
- micp->mi[micp->mi_i].entity = mon->name;
- micp->mi[micp->mi_i].node = mon->pid;
+ if (is_atom(mon->u.pid)) { /* external by name */
+ micp->mi[micp->mi_i].entity.term = mon->name;
+ micp->mi[micp->mi_i].node = mon->u.pid;
micp->sz += 3; /* need one 2-tuple */
- } else if (is_external_pid(mon->pid)) { /* external by pid */
- micp->mi[micp->mi_i].entity = mon->pid;
+ } else if (is_external_pid(mon->u.pid)) { /* external by pid */
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
micp->mi[micp->mi_i].node = NIL;
- micp->sz += NC_HEAP_SIZE(mon->pid);
+ micp->sz += NC_HEAP_SIZE(mon->u.pid);
} else if (!is_nil(mon->name)) { /* internal by name */
- micp->mi[micp->mi_i].entity = mon->name;
+ micp->mi[micp->mi_i].entity.term = mon->name;
micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname;
micp->sz += 3; /* need one 2-tuple */
} else { /* internal by pid */
- micp->mi[micp->mi_i].entity = mon->pid;
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
micp->mi[micp->mi_i].node = NIL;
/* no additional heap space needed */
}
@@ -473,7 +478,7 @@ static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp)
/* have always pid at hand, to assist with figuring out if its a port or
* a process, when we monitored by name and process_info is requested.
* See: erl_bif_info.c:process_info_aux section for am_monitors */
- micp->mi[micp->mi_i].pid = mon->pid;
+ micp->mi[micp->mi_i].pid = mon->u.pid;
micp->mi_i++;
micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */
@@ -483,15 +488,24 @@ static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp)
{
MonitorInfoCollection *micp = vmicp;
- if (mon->type != MON_TARGET) {
- return;
+ if (mon->type != MON_TARGET && mon->type != MON_NIF_TARGET) {
+ return;
}
EXTEND_MONITOR_INFOS(micp);
- micp->mi[micp->mi_i].node = NIL;
- micp->mi[micp->mi_i].entity = mon->pid;
- micp->sz += (NC_HEAP_SIZE(mon->pid) + 2 /* cons */);
+
+ if (mon->type == MON_NIF_TARGET) {
+ micp->mi[micp->mi_i].entity.resource = mon->u.resource;
+ micp->mi[micp->mi_i].node = make_small(MON_NIF_TARGET);
+ micp->sz += erts_resource_ref_size(mon->u.resource);
+ }
+ else {
+ micp->mi[micp->mi_i].entity.term = mon->u.pid;
+ micp->mi[micp->mi_i].node = NIL;
+ micp->sz += NC_HEAP_SIZE(mon->u.pid);
+ }
+ micp->sz += 2; /* cons */;
micp->mi_i++;
}
@@ -1222,7 +1236,7 @@ process_info_aux(Process *BIF_P,
hp = HAlloc(BIF_P, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
res = CONS(hp, item, res);
hp += 2;
}
@@ -1240,7 +1254,7 @@ process_info_aux(Process *BIF_P,
hp = HAlloc(BIF_P, 3 + mic.sz);
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- if (is_atom(mic.mi[i].entity)) {
+ if (is_atom(mic.mi[i].entity.term)) {
/* Monitor by name.
* Build {process|port, {Name, Node}} and cons it.
*/
@@ -1252,7 +1266,7 @@ process_info_aux(Process *BIF_P,
|| is_port(mic.mi[i].pid)
|| is_atom(mic.mi[i].pid));
- t1 = TUPLE2(hp, mic.mi[i].entity, mic.mi[i].node);
+ t1 = TUPLE2(hp, mic.mi[i].entity.term, mic.mi[i].node);
hp += 3;
t2 = TUPLE2(hp, m_type, t1);
hp += 3;
@@ -1262,7 +1276,7 @@ process_info_aux(Process *BIF_P,
else {
/* Monitor by pid. Build {process|port, Pid} and cons it. */
Eterm t;
- Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ Eterm pid = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
Eterm m_type = is_port(mic.mi[i].pid) ? am_port : am_process;
ASSERT(is_pid(mic.mi[i].pid)
@@ -1289,7 +1303,12 @@ process_info_aux(Process *BIF_P,
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
- item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity);
+ if (mic.mi[i].node == make_small(MON_NIF_TARGET)) {
+ item = erts_bld_resource_ref(&hp, &MSO(BIF_P), mic.mi[i].entity.resource);
+ }
+ else {
+ item = STORE_NC(&hp, &MSO(BIF_P), mic.mi[i].entity.term);
+ }
res = CONS(hp, item, res);
hp += 2;
}
@@ -2986,7 +3005,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
if (hpp) {
res = NIL;
for (i = 0; i < mic.mi_i; i++) {
- item = STORE_NC(hpp, ohp, mic.mi[i].entity);
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
res = CONS(*hpp, item, res);
*hpp += 2;
}
@@ -3017,7 +3036,7 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
Eterm t;
Eterm m_type;
- item = STORE_NC(hpp, ohp, mic.mi[i].entity);
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
m_type = is_port(item) ? am_port : am_process;
t = TUPLE2(*hpp, m_type, item);
*hpp += 3;
@@ -3046,7 +3065,8 @@ erts_bld_port_info(Eterm **hpp, ErlOffHeap *ohp, Uint *szp, Port *prt,
if (hpp) {
res = NIL;
for (i = 0; i < mic.mi_i; ++i) {
- item = STORE_NC(hpp, ohp, mic.mi[i].entity);
+ ASSERT(mic.mi[i].node == NIL);
+ item = STORE_NC(hpp, ohp, mic.mi[i].entity.term);
res = CONS(*hpp, item, res);
*hpp += 2;
}
diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h
index db259be2a7..946d3cfe03 100644
--- a/erts/emulator/beam/erl_binary.h
+++ b/erts/emulator/beam/erl_binary.h
@@ -79,11 +79,9 @@ struct magic_binary {
} u;
};
-#ifdef ARCH_32
-#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 4
-#else
-#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN 0
-#endif
+#define ERTS_MAGIC_BIN_BYTES_TO_ALIGN \
+ (offsetof(ErtsMagicBinary,u.aligned.data) - \
+ offsetof(ErtsMagicBinary,u.unaligned.data))
typedef union {
Binary binary;
diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c
index 6bf52fb303..885e955332 100644
--- a/erts/emulator/beam/erl_bits.c
+++ b/erts/emulator/beam/erl_bits.c
@@ -110,9 +110,6 @@ erts_init_bits(void)
{
ERTS_CT_ASSERT(offsetof(Binary,orig_bytes) % 8 == 0);
ERTS_CT_ASSERT(offsetof(ErtsMagicBinary,u.aligned.data) % 8 == 0);
- ERTS_CT_ASSERT(ERTS_MAGIC_BIN_BYTES_TO_ALIGN ==
- (offsetof(ErtsMagicBinary,u.aligned.data)
- - offsetof(ErtsMagicBinary,u.unaligned.data)));
ERTS_CT_ASSERT(offsetof(ErtsBinary,driver.binary.orig_bytes)
== offsetof(Binary,orig_bytes));
diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h
index 97a69140c3..b386b68cff 100644
--- a/erts/emulator/beam/erl_driver.h
+++ b/erts/emulator/beam/erl_driver.h
@@ -76,11 +76,10 @@ typedef struct {
# endif
#endif
-/* Values for mode arg to driver_select() */
-#define ERL_DRV_READ (1 << 0)
-#define ERL_DRV_WRITE (1 << 1)
-#define ERL_DRV_USE (1 << 2)
-#define ERL_DRV_USE_NO_CALLBACK (ERL_DRV_USE | (1 << 3))
+#define ERL_DRV_READ ((int)ERL_NIF_SELECT_READ)
+#define ERL_DRV_WRITE ((int)ERL_NIF_SELECT_WRITE)
+#define ERL_DRV_USE ((int)ERL_NIF_SELECT_STOP)
+#define ERL_DRV_USE_NO_CALLBACK (ERL_DRV_USE | (ERL_DRV_USE << 1))
/* Old deprecated */
#define DO_READ ERL_DRV_READ
@@ -176,13 +175,6 @@ struct erl_drv_event_data {
#endif
typedef struct erl_drv_event_data *ErlDrvEventData; /* Event data */
-/*
- * A driver monitor
- */
-typedef struct {
- unsigned char data[sizeof(void *)*4];
-} ErlDrvMonitor;
-
typedef struct {
unsigned long megasecs;
unsigned long secs;
diff --git a/erts/emulator/beam/erl_drv_nif.h b/erts/emulator/beam/erl_drv_nif.h
index 2489099b5c..2d21dac87a 100644
--- a/erts/emulator/beam/erl_drv_nif.h
+++ b/erts/emulator/beam/erl_drv_nif.h
@@ -49,6 +49,21 @@ typedef enum {
ERL_DIRTY_JOB_IO_BOUND = 2
} ErlDirtyJobFlags;
+/* Values for enif_select AND mode arg for driver_select() */
+enum ErlNifSelectFlags {
+ ERL_NIF_SELECT_READ = (1 << 0),
+ ERL_NIF_SELECT_WRITE = (1 << 1),
+ ERL_NIF_SELECT_STOP = (1 << 2)
+};
+
+/*
+ * A driver monitor
+ */
+typedef struct {
+ unsigned char data[sizeof(void *)*4];
+} ErlDrvMonitor;
+
+
#ifdef SIZEOF_CHAR
# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR
# undef SIZEOF_CHAR
diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c
index c98581a45e..6ff9aea5ab 100644
--- a/erts/emulator/beam/erl_lock_check.c
+++ b/erts/emulator/beam/erl_lock_check.c
@@ -89,6 +89,9 @@ static erts_lc_lock_order_t erts_lock_order[] = {
{ "hipe_mfait_lock", NULL },
#endif
{ "nodes_monitors", NULL },
+#ifdef ERTS_SMP
+ { "resource_monitors", "address" },
+#endif
{ "driver_list", NULL },
{ "proc_link", "pid" },
{ "proc_msgq", "pid" },
diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c
index f813f19dbc..6dee1d5ef3 100644
--- a/erts/emulator/beam/erl_monitors.c
+++ b/erts/emulator/beam/erl_monitors.c
@@ -109,7 +109,7 @@ static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2)
#define CP_LINK_VAL(To, Hp, From) \
do { \
- if (IS_CONST(From)) \
+ if (is_immed(From)) \
(To) = (From); \
else { \
Uint i__; \
@@ -128,15 +128,15 @@ do { \
} \
} while (0)
-static ErtsMonitor *create_monitor(Uint type, Eterm ref, Eterm pid, Eterm name)
+static ErtsMonitor *create_monitor(Uint type, Eterm ref, UWord entity, Eterm name)
{
Uint mon_size = ERTS_MONITOR_SIZE;
ErtsMonitor *n;
Eterm *hp;
mon_size += NC_HEAP_SIZE(ref);
- if (!IS_CONST(pid)) {
- mon_size += NC_HEAP_SIZE(pid);
+ if (type != MON_NIF_TARGET && is_not_immed(entity)) {
+ mon_size += NC_HEAP_SIZE(entity);
}
if (mon_size <= ERTS_MONITOR_SH_SIZE) {
@@ -155,7 +155,10 @@ static ErtsMonitor *create_monitor(Uint type, Eterm ref, Eterm pid, Eterm name)
n->balance = 0; /* Always the same initial value */
n->name = name; /* atom() or [] */
CP_LINK_VAL(n->ref, hp, ref); /*XXX Unnecessary check, never immediate*/
- CP_LINK_VAL(n->pid, hp, pid);
+ if (type == MON_NIF_TARGET)
+ n->u.resource = (ErtsResource*)entity;
+ else
+ CP_LINK_VAL(n->u.pid, hp, (Eterm)entity);
return n;
}
@@ -166,7 +169,7 @@ static ErtsLink *create_link(Uint type, Eterm pid)
ErtsLink *n;
Eterm *hp;
- if (!IS_CONST(pid)) {
+ if (is_not_immed(pid)) {
lnk_size += NC_HEAP_SIZE(pid);
}
@@ -225,16 +228,16 @@ void erts_destroy_monitor(ErtsMonitor *mon)
Uint mon_size = ERTS_MONITOR_SIZE;
ErlNode *node;
- ASSERT(!IS_CONST(mon->ref));
+ ASSERT(is_not_immed(mon->ref));
mon_size += NC_HEAP_SIZE(mon->ref);
if (is_external(mon->ref)) {
node = external_thing_ptr(mon->ref)->node;
erts_deref_node_entry(node);
}
- if (!IS_CONST(mon->pid)) {
- mon_size += NC_HEAP_SIZE(mon->pid);
- if (is_external(mon->pid)) {
- node = external_thing_ptr(mon->pid)->node;
+ if (mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid)) {
+ mon_size += NC_HEAP_SIZE(mon->u.pid);
+ if (is_external(mon->u.pid)) {
+ node = external_thing_ptr(mon->u.pid)->node;
erts_deref_node_entry(node);
}
}
@@ -253,7 +256,7 @@ void erts_destroy_link(ErtsLink *lnk)
ASSERT(lnk->type == LINK_NODE || ERTS_LINK_ROOT(lnk) == NULL);
- if (!IS_CONST(lnk->pid)) {
+ if (is_not_immed(lnk->pid)) {
lnk_size += NC_HEAP_SIZE(lnk->pid);
if (is_external(lnk->pid)) {
node = external_thing_ptr(lnk->pid)->node;
@@ -348,7 +351,7 @@ static void insertion_rotation(int dstack[], int dpos,
}
}
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
+void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
Eterm name)
{
void *tstack[STACK_NEED];
@@ -365,7 +368,7 @@ void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
for (;;) {
if (!*this) { /* Found our place */
state = 1;
- *this = create_monitor(type,ref,pid,name);
+ *this = create_monitor(type,ref,entity,name);
break;
} else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) {
/* go left */
@@ -935,8 +938,12 @@ static void erts_dump_monitors(ErtsMonitor *root, int indent)
if (root == NULL)
return;
erts_dump_monitors(root->right,indent+2);
- erts_printf("%*s[%b16d:%b16u:%T:%T:%T]\n", indent, "", root->balance,
- root->type, root->ref, root->pid, root->name);
+ erts_printf("%*s[%b16d:%b16u:%T:%T", indent, "", root->balance,
+ root->type, root->ref, root->name);
+ if (root->type == MON_NIF_TARGET)
+ erts_printf(":%p]\n", root->u.resource);
+ else
+ erts_printf(":%T]\n", root->u.pid);
erts_dump_monitors(root->left,indent+2);
}
@@ -1051,7 +1058,7 @@ void erts_one_link_size(ErtsLink *lnk, void *vpu)
{
Uint *pu = vpu;
*pu += ERTS_LINK_SIZE*sizeof(Uint);
- if(!IS_CONST(lnk->pid))
+ if(is_not_immed(lnk->pid))
*pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint);
if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) {
erts_doforall_links(ERTS_LINK_ROOT(lnk),&erts_one_link_size,vpu);
@@ -1061,8 +1068,8 @@ void erts_one_mon_size(ErtsMonitor *mon, void *vpu)
{
Uint *pu = vpu;
*pu += ERTS_MONITOR_SIZE*sizeof(Uint);
- if(!IS_CONST(mon->pid))
- *pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint);
- if(!IS_CONST(mon->ref))
+ if(mon->type != MON_NIF_TARGET && is_not_immed(mon->u.pid))
+ *pu += NC_HEAP_SIZE(mon->u.pid)*sizeof(Uint);
+ if(is_not_immed(mon->ref))
*pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint);
}
diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h
index bb493bf336..f659829e6c 100644
--- a/erts/emulator/beam/erl_monitors.h
+++ b/erts/emulator/beam/erl_monitors.h
@@ -82,8 +82,9 @@
/* Type tags for monitors */
#define MON_ORIGIN 1
-#define MON_TARGET 3
-#define MON_TIME_OFFSET 7
+#define MON_TARGET 2
+#define MON_NIF_TARGET 3
+#define MON_TIME_OFFSET 4
/* Type tags for links */
#define LINK_PID 1 /* ...Or port */
@@ -105,11 +106,15 @@ typedef struct erts_monitor_or_link {
typedef struct erts_monitor {
struct erts_monitor *left, *right;
Sint16 balance;
- Uint16 type; /* MON_ORIGIN | MON_TARGET | MON_TIME_OFFSET */
+ Uint16 type; /* MON_ORIGIN | MON_TARGET | MON_NIF_TARGET | MON_TIME_OFFSET */
Eterm ref;
- Eterm pid; /* In case of distributed named monitor, this is the
- nodename atom in MON_ORIGIN process, otherwise a pid or
- , in case of a MON_TARGET, a port */
+ union {
+ Eterm pid; /* In case of distributed named monitor, this is the
+ * nodename atom in MON_ORIGIN process, otherwise a pid or,
+ * in case of a MON_TARGET, a port
+ */
+ struct ErtsResource_* resource; /* MON_NIF_TARGET */
+ }u;
Eterm name; /* When monitoring a named process: atom() else [] */
Uint heap[1]; /* Larger in reality */
} ErtsMonitor;
@@ -144,7 +149,7 @@ Uint erts_tot_link_lh_size(void);
/* Prototypes */
void erts_destroy_monitor(ErtsMonitor *mon);
-void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid,
+void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, UWord entity,
Eterm name);
ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref);
ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref);
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index 7fe7b8bd93..e6da4c1a76 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -1942,37 +1942,9 @@ int enif_snprintf(char *buffer, size_t size, const char* format, ...)
** Memory managed (GC'ed) "resource" objects **
***********************************************************/
-
-struct enif_resource_type_t
-{
- struct enif_resource_type_t* next; /* list of all resource types */
- struct enif_resource_type_t* prev;
- struct erl_module_nif* owner; /* that created this type and thus implements the destructor*/
- ErlNifResourceDtor* dtor; /* user destructor function */
- erts_refc_t refc; /* num of resources of this type (HOTSPOT warning)
- +1 for active erl_module_nif */
- Eterm module;
- Eterm name;
-};
-
/* dummy node in circular list */
struct enif_resource_type_t resource_type_list;
-typedef struct enif_resource_t
-{
- struct enif_resource_type_t* type;
-#ifdef DEBUG
- erts_refc_t nif_refc;
-# ifdef ARCH_32
- byte align__[4];
-# endif
-#endif
- char data[1];
-}ErlNifResource;
-
-#define SIZEOF_ErlNifResource(SIZE) (offsetof(ErlNifResource,data) + (SIZE))
-#define DATA_TO_RESOURCE(PTR) ((ErlNifResource*)((char*)(PTR) - offsetof(ErlNifResource,data)))
-
static ErlNifResourceType* find_resource_type(Eterm module, Eterm name)
{
ErlNifResourceType* type;
@@ -2034,24 +2006,23 @@ struct opened_resource_type
ErlNifResourceFlags op;
ErlNifResourceType* type;
- ErlNifResourceDtor* new_dtor;
+ ErlNifResourceTypeInit new_callbacks;
};
static struct opened_resource_type* opened_rt_list = NULL;
-ErlNifResourceType*
-enif_open_resource_type(ErlNifEnv* env,
- const char* module_str,
- const char* name_str,
- ErlNifResourceDtor* dtor,
- ErlNifResourceFlags flags,
- ErlNifResourceFlags* tried)
+static
+ErlNifResourceType* open_resource_type(ErlNifEnv* env,
+ const char* name_str,
+ const ErlNifResourceTypeInit* init,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried,
+ size_t sizeof_init)
{
ErlNifResourceType* type = NULL;
ErlNifResourceFlags op = flags;
Eterm module_am, name_am;
ASSERT(erts_smp_thr_progress_is_blocking());
- ASSERT(module_str == NULL); /* for now... */
module_am = make_atom(env->mod_nif->mod->module);
name_am = enif_make_atom(env, name_str);
@@ -2085,7 +2056,9 @@ enif_open_resource_type(ErlNifEnv* env,
sizeof(struct opened_resource_type));
ort->op = op;
ort->type = type;
- ort->new_dtor = dtor;
+ sys_memzero(&ort->new_callbacks, sizeof(ErlNifResourceTypeInit));
+ ASSERT(sizeof_init > 0 && sizeof_init <= sizeof(ErlNifResourceTypeInit));
+ sys_memcpy(&ort->new_callbacks, init, sizeof_init);
ort->next = opened_rt_list;
opened_rt_list = ort;
}
@@ -2095,6 +2068,31 @@ enif_open_resource_type(ErlNifEnv* env,
return type;
}
+ErlNifResourceType*
+enif_open_resource_type(ErlNifEnv* env,
+ const char* module_str,
+ const char* name_str,
+ ErlNifResourceDtor* dtor,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried)
+{
+ ErlNifResourceTypeInit init = {dtor, NULL};
+ ASSERT(module_str == NULL); /* for now... */
+ return open_resource_type(env, name_str, &init, flags, tried,
+ sizeof(init));
+}
+
+ErlNifResourceType*
+enif_open_resource_type_x(ErlNifEnv* env,
+ const char* name_str,
+ const ErlNifResourceTypeInit* init,
+ ErlNifResourceFlags flags,
+ ErlNifResourceFlags* tried)
+{
+ return open_resource_type(env, name_str, init, flags, tried,
+ env->mod_nif->entry.sizeof_ErlNifResourceTypeInit);
+}
+
static void commit_opened_resource_types(struct erl_module_nif* lib)
{
while (opened_rt_list) {
@@ -2113,7 +2111,9 @@ static void commit_opened_resource_types(struct erl_module_nif* lib)
}
type->owner = lib;
- type->dtor = ort->new_dtor;
+ type->dtor = ort->new_callbacks.dtor;
+ type->stop = ort->new_callbacks.stop;
+ type->down = ort->new_callbacks.down;
if (type->dtor != NULL) {
erts_refc_inc(&lib->rt_dtor_cnt, 1);
@@ -2139,12 +2139,145 @@ static void rollback_opened_resource_types(void)
}
}
+struct destroy_monitor_ctx
+{
+ ErtsResource* resource;
+ int exiting_procs;
+ int scheduler;
+};
+
+static void destroy_one_monitor(ErtsMonitor* mon, void* context)
+{
+ struct destroy_monitor_ctx* ctx = (struct destroy_monitor_ctx*) context;
+ Process* rp;
+ ErtsMonitor *rmon = NULL;
+ int is_exiting;
+
+ ASSERT(mon->type == MON_ORIGIN);
+ ASSERT(is_internal_pid(mon->u.pid));
+ ASSERT(is_internal_ref(mon->ref));
+
+ if (ctx->scheduler > 0) { /* Normal scheduler */
+ rp = erts_proc_lookup(mon->u.pid);
+ }
+ else {
+#ifdef ERTS_SMP
+ rp = erts_proc_lookup_inc_refc(mon->u.pid);
+#else
+ ASSERT(!"nif monitor destruction in non-scheduler thread");
+ rp = NULL;
+#endif
+ }
+
+ if (!rp) {
+ is_exiting = 1;
+ }
+ if (rp) {
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_IS_EXITING(rp)) {
+ is_exiting = 1;
+ } else {
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), mon->ref);
+ ASSERT(rmon);
+ is_exiting = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+#ifdef ERTS_SMP
+ if (ctx->scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ }
+ if (is_exiting) {
+ ctx->resource->monitors->pending_failed_fire++;
+ }
+
+ /* ToDo: Delay destruction after monitor_locks */
+ if (rmon) {
+ ASSERT(rmon->type == MON_NIF_TARGET);
+ ASSERT(rmon->u.resource == ctx->resource);
+ erts_destroy_monitor(rmon);
+ }
+ erts_destroy_monitor(mon);
+}
+
+static void destroy_all_monitors(ErtsMonitor* monitors, ErtsResource* resource)
+{
+ struct destroy_monitor_ctx ctx;
+
+ execution_state(NULL, NULL, &ctx.scheduler);
+
+ ctx.resource = resource;
+ erts_sweep_monitors(monitors, &destroy_one_monitor, &ctx);
+}
+
+
+#ifdef ERTS_SMP
+# define NIF_RESOURCE_DTOR &nif_resource_dtor
+#else
+# define NIF_RESOURCE_DTOR &nosmp_nif_resource_dtor_prologue
+
+/*
+ * NO-SMP: Always run resource destructor on scheduler thread
+ * as we may have to remove process monitors.
+ */
+static int nif_resource_dtor(Binary*);
+
+static void nosmp_nif_resource_dtor_scheduled(void* vbin)
+{
+ erts_bin_free((Binary*)vbin);
+}
+
+static int nosmp_nif_resource_dtor_prologue(Binary* bin)
+{
+ if (is_scheduler()) {
+ return nif_resource_dtor(bin);
+ }
+ else {
+ erts_schedule_misc_aux_work(1, nosmp_nif_resource_dtor_scheduled, bin);
+ return 0; /* do not free */
+ }
+}
+
+#endif /* !ERTS_SMP */
static int nif_resource_dtor(Binary* bin)
{
- ErlNifResource* resource = (ErlNifResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
+ ErtsResource* resource = (ErtsResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
ErlNifResourceType* type = resource->type;
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+
+ if (resource->monitors) {
+ ErtsResourceMonitors* rm = resource->monitors;
+
+ ASSERT(type->down);
+ erts_smp_mtx_lock(&rm->lock);
+ ASSERT(erts_refc_read(&bin->refc, 0) == 0);
+ if (rm->root) {
+ ASSERT(!rm->is_dying);
+ destroy_all_monitors(rm->root, resource);
+ rm->root = NULL;
+ }
+ if (rm->pending_failed_fire) {
+ /*
+ * Resource death struggle prolonged to serve exiting process(es).
+ * Destructor will be called again when last exiting process
+ * tries to fire its MON_NIF_TARGET monitor (and fails).
+ *
+ * This resource is doomed. It has no "real" references and
+ * should get not get called upon to do anything except the
+ * final destructor call.
+ *
+ * We keep refc at 0 and use a separate counter for exiting
+ * processes to avoid resource getting revived by "dec_term".
+ */
+ ASSERT(!rm->is_dying);
+ rm->is_dying = 1;
+ erts_smp_mtx_unlock(&rm->lock);
+ return 0;
+ }
+ erts_smp_mtx_unlock(&rm->lock);
+ erts_smp_mtx_destroy(&rm->lock);
+ }
if (type->dtor != NULL) {
struct enif_msg_environment_t msg_env;
@@ -2162,13 +2295,89 @@ static int nif_resource_dtor(Binary* bin)
return 1;
}
-void* enif_alloc_resource(ErlNifResourceType* type, size_t size)
+void erts_resource_stop(ErtsResource* resource, ErlNifEvent e,
+ int is_direct_call)
{
- Binary* bin = erts_create_magic_binary_x(SIZEOF_ErlNifResource(size),
- &nif_resource_dtor,
- ERTS_ALC_T_BINARY,
- 1); /* unaligned */
- ErlNifResource* resource = ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
+ struct enif_msg_environment_t msg_env;
+ ASSERT(resource->type->stop);
+ pre_nif_noproc(&msg_env, resource->type->owner, NULL);
+ resource->type->stop(&msg_env.env, resource->data, e, is_direct_call);
+ post_nif_noproc(&msg_env);
+}
+
+void erts_fire_nif_monitor(ErtsResource* resource, Eterm pid, Eterm ref)
+{
+ ErtsMonitor* rmon;
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ struct enif_msg_environment_t msg_env;
+ ErlNifPid nif_pid;
+ ErlNifMonitor nif_monitor;
+ ErtsResourceMonitors* rmp = resource->monitors;
+
+ ASSERT(rmp);
+ ASSERT(resource->type->down);
+
+ erts_smp_mtx_lock(&rmp->lock);
+ rmon = erts_remove_monitor(&rmp->root, ref);
+ if (!rmon) {
+ int free_me = (--rmp->pending_failed_fire == 0) && rmp->is_dying;
+ ASSERT(rmp->pending_failed_fire >= 0);
+ erts_smp_mtx_unlock(&rmp->lock);
+
+ if (free_me) {
+ ASSERT(erts_refc_read(&bin->binary.refc, 0) == 0);
+ erts_bin_free(&bin->binary);
+ }
+ return;
+ }
+ ASSERT(!rmp->is_dying);
+ if (erts_refc_inc_unless(&bin->binary.refc, 0, 0) == 0) {
+ /*
+ * Racing resource destruction.
+ * To avoid a more complex refc-dance with destructing thread
+ * we avoid calling 'down' and just silently remove the monitor.
+ * This can happen even for non smp as destructor calls may be scheduled.
+ */
+ erts_smp_mtx_unlock(&rmp->lock);
+ }
+ else {
+ erts_smp_mtx_unlock(&rmp->lock);
+
+ ASSERT(rmon->u.pid == pid);
+ erts_ref_to_driver_monitor(ref, &nif_monitor);
+ nif_pid.pid = pid;
+ pre_nif_noproc(&msg_env, resource->type->owner, NULL);
+ resource->type->down(&msg_env.env, resource->data, &nif_pid, &nif_monitor);
+ post_nif_noproc(&msg_env);
+
+ if (erts_refc_dectest(&bin->binary.refc, 0) == 0) {
+ erts_bin_free(&bin->binary);
+ }
+ }
+ erts_destroy_monitor(rmon);
+}
+
+void* enif_alloc_resource(ErlNifResourceType* type, size_t data_sz)
+{
+ size_t magic_sz = offsetof(ErtsResource,data);
+ Binary* bin;
+ ErtsResource* resource;
+ size_t monitors_offs;
+
+ if (type->down) {
+ /* Put ErtsResourceMonitors after user data and properly aligned */
+ monitors_offs = ((data_sz + ERTS_ALLOC_ALIGN_BYTES - 1)
+ & ~((size_t)ERTS_ALLOC_ALIGN_BYTES - 1));
+ magic_sz += monitors_offs + sizeof(ErtsResourceMonitors);
+ }
+ else {
+ ERTS_UNDEF(monitors_offs, 0);
+ magic_sz += data_sz;
+ }
+ bin = erts_create_magic_binary_x(magic_sz, NIF_RESOURCE_DTOR,
+ ERTS_ALC_T_BINARY,
+ 1); /* unaligned */
+ resource = ERTS_MAGIC_BIN_UNALIGNED_DATA(bin);
ASSERT(type->owner && type->next && type->prev); /* not allowed in load/upgrade */
resource->type = type;
@@ -2177,15 +2386,27 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t size)
erts_refc_init(&resource->nif_refc, 1);
#endif
erts_refc_inc(&resource->type->refc, 2);
+ if (type->down) {
+ resource->monitors = (ErtsResourceMonitors*) (resource->data + monitors_offs);
+ erts_smp_mtx_init(&resource->monitors->lock, "resource_monitors");
+ resource->monitors->root = NULL;
+ resource->monitors->pending_failed_fire = 0;
+ resource->monitors->is_dying = 0;
+ resource->monitors->user_data_sz = data_sz;
+ }
+ else {
+ resource->monitors = NULL;
+ }
return resource->data;
}
void enif_release_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
#ifdef DEBUG
erts_refc_dec(&resource->nif_refc, 0);
#endif
@@ -2196,28 +2417,37 @@ void enif_release_resource(void* obj)
void enif_keep_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
- ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == &nif_resource_dtor);
+ ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(bin) == NIF_RESOURCE_DTOR);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
#ifdef DEBUG
erts_refc_inc(&resource->nif_refc, 1);
#endif
erts_refc_inc(&bin->binary.refc, 2);
}
+Eterm erts_bld_resource_ref(Eterm** hpp, ErlOffHeap* oh, ErtsResource* resource)
+{
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
+ return erts_mk_magic_ref(hpp, oh, &bin->binary);
+}
+
ERL_NIF_TERM enif_make_resource(ErlNifEnv* env, void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
Eterm* hp = alloc_heap(env, ERTS_MAGIC_REF_THING_SIZE);
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
return erts_mk_magic_ref(&hp, &MSO(env->proc), &bin->binary);
}
ERL_NIF_TERM enif_make_resource_binary(ErlNifEnv* env, void* obj,
const void* data, size_t size)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
ErlOffHeap *ohp = &MSO(env->proc);
Eterm* hp = alloc_heap(env,PROC_BIN_SIZE);
@@ -2241,7 +2471,7 @@ int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* typ
void** objp)
{
Binary* mbin;
- ErlNifResource* resource;
+ ErtsResource* resource;
if (is_internal_magic_ref(term))
mbin = erts_magic_ref2bin(term);
else {
@@ -2260,8 +2490,8 @@ int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* typ
if (!(mbin->flags & BIN_FLAG_MAGIC))
return 0;
}
- resource = (ErlNifResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(mbin);
- if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != &nif_resource_dtor
+ resource = (ErtsResource*) ERTS_MAGIC_BIN_UNALIGNED_DATA(mbin);
+ if (ERTS_MAGIC_BIN_DESTRUCTOR(mbin) != NIF_RESOURCE_DTOR
|| resource->type != type) {
return 0;
}
@@ -2271,9 +2501,14 @@ int enif_get_resource(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifResourceType* typ
size_t enif_sizeof_resource(void* obj)
{
- ErlNifResource* resource = DATA_TO_RESOURCE(obj);
- Binary* bin = &ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource)->binary;
- return ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(bin) - offsetof(ErlNifResource,data);
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ if (resource->monitors) {
+ return resource->monitors->user_data_sz;
+ }
+ else {
+ Binary* bin = &ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource)->binary;
+ return ERTS_MAGIC_BIN_UNALIGNED_DATA_SIZE(bin) - offsetof(ErtsResource,data);
+ }
}
@@ -2885,6 +3120,157 @@ int enif_map_iterator_get_pair(ErlNifEnv *env,
return 0;
}
+int enif_monitor_process(ErlNifEnv* env, void* obj, const ErlNifPid* target_pid,
+ ErlNifMonitor* monitor)
+{
+ int scheduler;
+ ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
+ Process *rp;
+ Eterm tmp[ERTS_REF_THING_SIZE];
+ Eterm ref;
+ int retval;
+
+ ASSERT(ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc)->magic_binary.destructor
+ == NIF_RESOURCE_DTOR);
+ ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
+ ASSERT(!rsrc->monitors == !rsrc->type->down);
+
+
+ if (!rsrc->monitors) {
+ ASSERT(!rsrc->type->down);
+ return -1;
+ }
+ ASSERT(rsrc->type->down);
+
+ execution_state(env, NULL, &scheduler);
+
+#ifdef ERTS_SMP
+ if (scheduler > 0) /* Normal scheduler */
+ rp = erts_proc_lookup_raw(target_pid->pid);
+ else
+ rp = erts_proc_lookup_raw_inc_refc(target_pid->pid);
+#else
+ if (scheduler <= 0) {
+ erts_exit(ERTS_ABORT_EXIT, "enif_monitor_process: called from "
+ "non-scheduler thread on non-SMP VM");
+ }
+ rp = erts_proc_lookup(target_pid->pid);
+#endif
+
+ if (!rp)
+ return 1;
+
+ ref = erts_make_ref_in_buffer(tmp);
+
+ erts_smp_mtx_lock(&rsrc->monitors->lock);
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PSFLG_FREE & erts_smp_atomic32_read_nob(&rp->state)) {
+ retval = 1;
+ }
+ else {
+ erts_add_monitor(&rsrc->monitors->root, MON_ORIGIN, ref, rp->common.id, NIL);
+ erts_add_monitor(&ERTS_P_MONITORS(rp), MON_NIF_TARGET, ref, (UWord)rsrc, NIL);
+ retval = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+
+#ifdef ERTS_SMP
+ if (scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ if (monitor)
+ erts_ref_to_driver_monitor(ref,monitor);
+
+ return retval;
+}
+
+int enif_demonitor_process(ErlNifEnv* env, void* obj, const ErlNifMonitor* monitor)
+{
+ int scheduler;
+ ErtsResource* rsrc = DATA_TO_RESOURCE(obj);
+#ifdef DEBUG
+ ErtsBinary* bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(rsrc);
+#endif
+ Process *rp;
+ ErtsMonitor *mon;
+ ErtsMonitor *rmon = NULL;
+ Eterm ref_heap[ERTS_REF_THING_SIZE];
+ Eterm ref;
+ int is_exiting;
+
+ ASSERT(bin->magic_binary.destructor == NIF_RESOURCE_DTOR);
+ ASSERT(!(rsrc->monitors && rsrc->monitors->is_dying));
+
+ execution_state(env, NULL, &scheduler);
+
+ ref = erts_driver_monitor_to_ref(ref_heap, monitor);
+
+ erts_smp_mtx_lock(&rsrc->monitors->lock);
+ mon = erts_remove_monitor(&rsrc->monitors->root, ref);
+
+ if (mon == NULL) {
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+ return 1;
+ }
+
+ ASSERT(mon->type == MON_ORIGIN);
+ ASSERT(is_internal_pid(mon->u.pid));
+
+#ifdef ERTS_SMP
+ if (scheduler > 0) /* Normal scheduler */
+ rp = erts_proc_lookup(mon->u.pid);
+ else
+ rp = erts_proc_lookup_inc_refc(mon->u.pid);
+#else
+ if (scheduler <= 0) {
+ erts_exit(ERTS_ABORT_EXIT, "enif_demonitor_process: called from "
+ "non-scheduler thread on non-SMP VM");
+ }
+ rp = erts_proc_lookup(mon->u.pid);
+#endif
+
+ if (!rp) {
+ is_exiting = 1;
+ }
+ else {
+ erts_smp_proc_lock(rp, ERTS_PROC_LOCK_LINK);
+ if (ERTS_PROC_IS_EXITING(rp)) {
+ is_exiting = 1;
+ } else {
+ rmon = erts_remove_monitor(&ERTS_P_MONITORS(rp), ref);
+ ASSERT(rmon);
+ is_exiting = 0;
+ }
+ erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
+
+#ifdef ERTS_SMP
+ if (scheduler <= 0)
+ erts_proc_dec_refc(rp);
+#endif
+ }
+ if (is_exiting) {
+ rsrc->monitors->pending_failed_fire++;
+ }
+ erts_smp_mtx_unlock(&rsrc->monitors->lock);
+
+ if (rmon) {
+ ASSERT(rmon->type == MON_NIF_TARGET);
+ ASSERT(rmon->u.resource == rsrc);
+ erts_destroy_monitor(rmon);
+ }
+ erts_destroy_monitor(mon);
+
+ return 0;
+}
+
+int enif_compare_monitors(const ErlNifMonitor *monitor1,
+ const ErlNifMonitor *monitor2)
+{
+ return sys_memcmp((void *) monitor1, (void *) monitor2,
+ ERTS_REF_THING_SIZE*sizeof(Eterm));
+}
+
/***************************************************************************
** load_nif/2 **
***************************************************************************/
@@ -3035,6 +3421,11 @@ static struct erl_module_nif* create_lib(const ErlNifEntry* src)
dst->funcs = lib->_funcs_copy_;
dst->options = 0;
}
+ if (AT_LEAST_VERSION(src, 2, 12)) {
+ dst->sizeof_ErlNifResourceTypeInit = src->sizeof_ErlNifResourceTypeInit;
+ } else {
+ dst->sizeof_ErlNifResourceTypeInit = 0;
+ }
return lib;
};
@@ -3353,7 +3744,8 @@ erts_unload_nif(struct erl_module_nif* lib)
void erl_nif_init()
{
- ERTS_CT_ASSERT((offsetof(ErlNifResource,data) % 8) == ERTS_MAGIC_BIN_BYTES_TO_ALIGN);
+ ERTS_CT_ASSERT((offsetof(ErtsResource,data) % 8)
+ == ERTS_MAGIC_BIN_BYTES_TO_ALIGN);
resource_type_list.next = &resource_type_list;
resource_type_list.prev = &resource_type_list;
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index 413b4f7343..ac45f3ac81 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -52,7 +52,7 @@
** 2.11: 19.0 enif_snprintf
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 11
+#define ERL_NIF_MINOR_VERSION 12
/*
* The emulator will refuse to load a nif-lib with a major version
@@ -122,6 +122,9 @@ typedef struct enif_entry_t
/* Added in 2.7 */
unsigned options; /* Unused. Can be set to 0 or 1 (dirty sched config) */
+
+ /* Added in 2.12 */
+ size_t sizeof_ErlNifResourceTypeInit;
}ErlNifEntry;
@@ -135,8 +138,18 @@ typedef struct
void* ref_bin;
}ErlNifBinary;
-typedef struct enif_resource_type_t ErlNifResourceType;
-typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_))
+typedef void* ErlNifEvent; /* FIXME: Use 'HANDLE' somehow without breaking existing source */
+#else
+typedef int ErlNifEvent;
+#endif
+
+/* Return bits from enif_select: */
+#define ERL_NIF_SELECT_STOP_CALLED (1 << 0)
+#define ERL_NIF_SELECT_STOP_SCHEDULED (1 << 1)
+#define ERL_NIF_SELECT_INVALID_EVENT (1 << 2)
+#define ERL_NIF_SELECT_FAILED (1 << 3)
+
typedef enum
{
ERL_NIF_RT_CREATE = 1,
@@ -158,6 +171,19 @@ typedef struct
ERL_NIF_TERM port_id; /* internal, may change */
}ErlNifPort;
+typedef ErlDrvMonitor ErlNifMonitor;
+
+typedef struct enif_resource_type_t ErlNifResourceType;
+typedef void ErlNifResourceDtor(ErlNifEnv*, void*);
+typedef void ErlNifResourceStop(ErlNifEnv*, void*, ErlNifEvent, int is_direct_call);
+typedef void ErlNifResourceDown(ErlNifEnv*, void*, ErlNifPid*, ErlNifMonitor*);
+
+typedef struct {
+ ErlNifResourceDtor* dtor;
+ ErlNifResourceStop* stop; /* at ERL_NIF_SELECT_STOP event */
+ ErlNifResourceDown* down; /* enif_monitor_process */
+} ErlNifResourceTypeInit;
+
typedef ErlDrvSysInfo ErlNifSysInfo;
typedef struct ErlDrvTid_ *ErlNifTid;
@@ -292,7 +318,8 @@ ERL_NIF_INIT_DECL(NAME) \
FUNCS, \
LOAD, RELOAD, UPGRADE, UNLOAD, \
ERL_NIF_VM_VARIANT, \
- 1 \
+ 1, \
+ sizeof(ErlNifResourceTypeInit) \
}; \
ERL_NIF_INIT_BODY; \
return &entry; \
diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h
index 9a8f216773..01d9e386ed 100644
--- a/erts/emulator/beam/erl_nif_api_funcs.h
+++ b/erts/emulator/beam/erl_nif_api_funcs.h
@@ -175,6 +175,11 @@ ERL_NIF_API_FUNC_DECL(size_t, enif_binary_to_term, (ErlNifEnv *env, const unsign
ERL_NIF_API_FUNC_DECL(int, enif_port_command, (ErlNifEnv *env, const ErlNifPort* to_port, ErlNifEnv *msg_env, ERL_NIF_TERM msg));
ERL_NIF_API_FUNC_DECL(int,enif_thread_type,(void));
ERL_NIF_API_FUNC_DECL(int,enif_snprintf,(char * buffer, size_t size, const char *format, ...));
+ERL_NIF_API_FUNC_DECL(int,enif_select,(ErlNifEnv* env, ErlNifEvent e, enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, ERL_NIF_TERM ref));
+ERL_NIF_API_FUNC_DECL(ErlNifResourceType*,enif_open_resource_type_x,(ErlNifEnv*, const char* name_str, const ErlNifResourceTypeInit*, ErlNifResourceFlags flags, ErlNifResourceFlags* tried));
+ERL_NIF_API_FUNC_DECL(int, enif_monitor_process,(ErlNifEnv*,void* obj,const ErlNifPid*,ErlDrvMonitor *monitor));
+ERL_NIF_API_FUNC_DECL(int, enif_demonitor_process,(ErlNifEnv*,void* obj,const ErlDrvMonitor *monitor));
+ERL_NIF_API_FUNC_DECL(int, enif_compare_monitors,(const ErlNifMonitor*,const ErlNifMonitor*));
/*
** ADD NEW ENTRIES HERE (before this comment) !!!
@@ -332,6 +337,11 @@ ERL_NIF_API_FUNC_DECL(int,enif_snprintf,(char * buffer, size_t size, const char
# define enif_port_command ERL_NIF_API_FUNC_MACRO(enif_port_command)
# define enif_thread_type ERL_NIF_API_FUNC_MACRO(enif_thread_type)
# define enif_snprintf ERL_NIF_API_FUNC_MACRO(enif_snprintf)
+# define enif_select ERL_NIF_API_FUNC_MACRO(enif_select)
+# define enif_open_resource_type_x ERL_NIF_API_FUNC_MACRO(enif_open_resource_type_x)
+# define enif_monitor_process ERL_NIF_API_FUNC_MACRO(enif_monitor_process)
+# define enif_demonitor_process ERL_NIF_API_FUNC_MACRO(enif_demonitor_process)
+# define enif_compare_monitors ERL_NIF_API_FUNC_MACRO(enif_compare_monitors)
/*
** ADD NEW ENTRIES HERE (before this comment)
diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c
index 5e54e5aef2..e2072fe30f 100644
--- a/erts/emulator/beam/erl_node_tables.c
+++ b/erts/emulator/beam/erl_node_tables.c
@@ -1166,8 +1166,8 @@ insert_offheap(ErlOffHeap *oh, int type, Eterm id)
static void doit_insert_monitor(ErtsMonitor *monitor, void *p)
{
Eterm *idp = p;
- if(is_external(monitor->pid))
- insert_node(external_thing_ptr(monitor->pid)->node, MONITOR_REF, *idp);
+ if(monitor->type != MON_NIF_TARGET && is_external(monitor->u.pid))
+ insert_node(external_thing_ptr(monitor->u.pid)->node, MONITOR_REF, *idp);
if(is_external(monitor->ref))
insert_node(external_thing_ptr(monitor->ref)->node, MONITOR_REF, *idp);
}
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index c5a7b67764..52d9f9ddf7 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -13323,9 +13323,9 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
switch (mon->type) {
case MON_ORIGIN:
/* We are monitoring someone else, we need to demonitor that one.. */
- if (is_atom(mon->pid)) { /* remote by name */
- ASSERT(is_node_name_atom(mon->pid));
- dep = erts_sysname_to_connected_dist_entry(mon->pid);
+ if (is_atom(mon->u.pid)) { /* remote by name */
+ ASSERT(is_node_name_atom(mon->u.pid));
+ dep = erts_sysname_to_connected_dist_entry(mon->u.pid);
if (dep) {
erts_smp_de_links_lock(dep);
rmon = erts_remove_monitor(&(dep->monitors), mon->ref);
@@ -13336,7 +13336,7 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_demonitor(&dsd,
- rmon->pid,
+ rmon->u.pid,
mon->name,
mon->ref,
1);
@@ -13347,10 +13347,10 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
erts_deref_dist_entry(dep);
}
} else {
- ASSERT(is_pid(mon->pid) || is_port(mon->pid));
+ ASSERT(is_pid(mon->u.pid) || is_port(mon->u.pid));
/* if is local by pid or name */
- if (is_internal_pid(mon->pid)) {
- Process *rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK);
+ if (is_internal_pid(mon->u.pid)) {
+ Process *rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
if (!rp) {
goto done;
}
@@ -13360,9 +13360,9 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
goto done;
}
erts_destroy_monitor(rmon);
- } else if (is_internal_port(mon->pid)) {
+ } else if (is_internal_port(mon->u.pid)) {
/* Is a local port */
- Port *prt = erts_port_lookup_raw(mon->pid);
+ Port *prt = erts_port_lookup_raw(mon->u.pid);
if (!prt) {
goto done;
}
@@ -13370,8 +13370,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_PORT_DEMONITOR_ORIGIN_ON_DEATHBED,
prt, mon->ref, NULL);
} else { /* remote by pid */
- ASSERT(is_external_pid(mon->pid));
- dep = external_pid_dist_entry(mon->pid);
+ ASSERT(is_external_pid(mon->u.pid));
+ dep = external_pid_dist_entry(mon->u.pid);
ASSERT(dep != NULL);
if (dep) {
erts_smp_de_links_lock(dep);
@@ -13383,8 +13383,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_demonitor(&dsd,
- rmon->pid,
- mon->pid,
+ rmon->u.pid,
+ mon->u.pid,
mon->ref,
1);
ASSERT(code == ERTS_DSIG_SEND_OK);
@@ -13396,22 +13396,21 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
}
break;
case MON_TARGET:
- ASSERT(mon->type == MON_TARGET);
- ASSERT(is_pid(mon->pid) || is_internal_port(mon->pid));
- if (is_internal_port(mon->pid)) {
- Port *prt = erts_id2port(mon->pid);
+ ASSERT(is_pid(mon->u.pid) || is_internal_port(mon->u.pid));
+ if (is_internal_port(mon->u.pid)) {
+ Port *prt = erts_id2port(mon->u.pid);
if (prt == NULL) {
goto done;
}
erts_fire_port_monitor(prt, mon->ref);
erts_port_release(prt);
- } else if (is_internal_pid(mon->pid)) {/* local by name or pid */
+ } else if (is_internal_pid(mon->u.pid)) {/* local by name or pid */
Eterm watched;
Process *rp;
DeclareTmpHeapNoproc(lhp,3);
ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK
| ERTS_PROC_LOCKS_MSG_SEND);
- rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks);
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, rp_locks);
if (rp == NULL) {
goto done;
}
@@ -13430,8 +13429,8 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
/* else: demonitor while we exited, i.e. do nothing... */
erts_smp_proc_unlock(rp, rp_locks);
} else { /* external by pid or name */
- ASSERT(is_external_pid(mon->pid));
- dep = external_pid_dist_entry(mon->pid);
+ ASSERT(is_external_pid(mon->u.pid));
+ dep = external_pid_dist_entry(mon->u.pid);
ASSERT(dep != NULL);
if (dep) {
erts_smp_de_links_lock(dep);
@@ -13443,10 +13442,10 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
ERTS_DSP_NO_LOCK, 0);
if (code == ERTS_DSIG_PREP_CONNECTED) {
code = erts_dsig_send_m_exit(&dsd,
- mon->pid,
+ mon->u.pid,
(rmon->name != NIL
? rmon->name
- : rmon->pid),
+ : rmon->u.pid),
mon->ref,
pcontext->reason);
ASSERT(code == ERTS_DSIG_SEND_OK);
@@ -13456,6 +13455,11 @@ static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext)
}
}
break;
+ case MON_NIF_TARGET:
+ erts_fire_nif_monitor(mon->u.resource,
+ pcontext->p->common.id,
+ mon->ref);
+ break;
case MON_TIME_OFFSET:
erts_demonitor_time_offset(mon->ref);
break;
diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c
index ed40539b78..cf9d3adc86 100644
--- a/erts/emulator/beam/erl_time_sup.c
+++ b/erts/emulator/beam/erl_time_sup.c
@@ -1869,7 +1869,7 @@ save_time_offset_monitor(ErtsMonitor *mon, void *vcntxt)
cntxt = (ErtsTimeOffsetMonitorContext *) vcntxt;
mix = (cntxt->ix)++;
- cntxt->to_mon_info[mix].pid = mon->pid;
+ cntxt->to_mon_info[mix].pid = mon->u.pid;
to_hp = &cntxt->to_mon_info[mix].heap[0];
ASSERT(is_internal_ordinary_ref(mon->ref));
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index fff22fe9c1..c4c848f49f 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -42,6 +42,7 @@
#include "erl_utils.h"
#include "erl_port.h"
#include "erl_gc.h"
+#include "erl_nif.h"
#define ERTS_BINARY_TYPES_ONLY__
#include "erl_binary.h"
#undef ERTS_BINARY_TYPES_ONLY__
@@ -68,9 +69,54 @@ struct enif_environment_t /* ErlNifEnv */
int dbg_disable_assert_in_env;
#endif
};
+struct enif_resource_type_t
+{
+ struct enif_resource_type_t* next; /* list of all resource types */
+ struct enif_resource_type_t* prev;
+ struct erl_module_nif* owner; /* that created this type and thus implements the destructor*/
+ ErlNifResourceDtor* dtor; /* user destructor function */
+ ErlNifResourceStop* stop;
+ ErlNifResourceDown* down;
+ erts_refc_t refc; /* num of resources of this type (HOTSPOT warning)
+ +1 for active erl_module_nif */
+ Eterm module;
+ Eterm name;
+};
+
+typedef struct
+{
+ erts_smp_mtx_t lock;
+ ErtsMonitor* root;
+ int pending_failed_fire;
+ int is_dying;
+
+ size_t user_data_sz;
+} ErtsResourceMonitors;
+
+typedef struct ErtsResource_
+{
+ struct enif_resource_type_t* type;
+ ErtsResourceMonitors* monitors;
+#ifdef DEBUG
+ erts_refc_t nif_refc;
+#else
+# ifdef ARCH_32
+ byte align__[4];
+# endif
+#endif
+ char data[1];
+}ErtsResource;
+
+#define DATA_TO_RESOURCE(PTR) ErtsContainerStruct(PTR, ErtsResource, data)
+#define erts_resource_ref_size(P) ERTS_MAGIC_REF_THING_SIZE
+
+extern Eterm erts_bld_resource_ref(Eterm** hp, ErlOffHeap*, ErtsResource*);
+
extern void erts_pre_nif(struct enif_environment_t*, Process*,
struct erl_module_nif*, Process* tracee);
extern void erts_post_nif(struct enif_environment_t* env);
+extern void erts_resource_stop(ErtsResource*, ErlNifEvent, int is_direct_call);
+void erts_fire_nif_monitor(ErtsResource*, Eterm pid, Eterm ref);
extern Eterm erts_nif_taints(Process* p);
extern void erts_print_nif_taints(fmtfn_t to, void* to_arg);
void erts_unload_nif(struct erl_module_nif* nif);
@@ -1129,6 +1175,8 @@ void erts_stale_drv_select(Eterm, ErlDrvPort, ErlDrvEvent, int, int);
Port *erts_get_heart_port(void);
void erts_emergency_close_ports(void);
+void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon);
+Eterm erts_driver_monitor_to_ref(Eterm* hp, const ErlDrvMonitor *mon);
#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT)
void erts_lcnt_enable_io_lock_count(int enable);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index e0cc756887..ebff564421 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -4192,8 +4192,8 @@ static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc)
ErtsMonitor *rmon;
Process *rp;
- ASSERT(is_internal_pid(mon->pid));
- rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK);
+ ASSERT(is_internal_pid(mon->u.pid));
+ rp = erts_pid2proc(NULL, 0, mon->u.pid, ERTS_PROC_LOCK_LINK);
if (!rp) {
goto done;
}
@@ -4294,7 +4294,7 @@ port_fire_one_monitor(ErtsMonitor *mon, void *ctx0)
Process *origin;
ErtsProcLocks origin_locks;
- if (mon->type != MON_TARGET || ! is_pid(mon->pid)) {
+ if (mon->type != MON_TARGET || ! is_pid(mon->u.pid)) {
return;
}
/*
@@ -4303,7 +4303,7 @@ port_fire_one_monitor(ErtsMonitor *mon, void *ctx0)
*/
origin_locks = ERTS_PROC_LOCKS_MSG_SEND | ERTS_PROC_LOCK_LINK;
- origin = erts_pid2proc(NULL, 0, mon->pid, origin_locks);
+ origin = erts_pid2proc(NULL, 0, mon->u.pid, origin_locks);
if (origin) {
DeclareTmpHeapNoproc(lhp,3);
SweepContext *ctx = (SweepContext *)ctx0;
@@ -4882,10 +4882,16 @@ erts_port_control(Process* c_p,
ASSERT(!tmp_alloced);
if (*ebinp == HEADER_SUB_BIN)
ebinp = binary_val(((ErlSubBin *) ebinp)->orig);
+
if (*ebinp != HEADER_PROC_BIN)
copy = 1;
else {
- binp = ((ProcBin *) ebinp)->val;
+ ProcBin *pb = (ProcBin *) ebinp;
+
+ if (pb->flags)
+ erts_emasculate_writable_binary(pb);
+
+ binp = pb->val;
ASSERT(bufp <= bufp + size);
ASSERT(binp->orig_bytes <= bufp
&& bufp + size <= binp->orig_bytes + binp->orig_size);
@@ -5485,7 +5491,7 @@ typedef struct {
static void prt_one_monitor(ErtsMonitor *mon, void *vprtd)
{
prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd;
- erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->pid,mon->ref);
+ erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->u.pid, mon->ref);
}
static void prt_one_lnk(ErtsLink *lnk, void *vprtd)
@@ -7607,7 +7613,7 @@ erl_drv_convert_time_unit(ErlDrvTime val,
(int) to);
}
-static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
+void erts_ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
{
ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Uint) <= sizeof(ErlDrvMonitor));
ASSERT(is_internal_ordinary_ref(ref));
@@ -7615,7 +7621,7 @@ static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon)
ERTS_REF_THING_SIZE*sizeof(Uint));
}
-static Eterm driver_monitor_to_ref(Eterm *hp, const ErlDrvMonitor *mon)
+Eterm erts_driver_monitor_to_ref(Eterm *hp, const ErlDrvMonitor *mon)
{
Eterm ref;
ERTS_CT_ASSERT(ERTS_REF_THING_SIZE*sizeof(Uint) <= sizeof(ErlDrvMonitor));
@@ -7648,7 +7654,7 @@ static int do_driver_monitor_process(Port *prt,
erts_add_monitor(&ERTS_P_MONITORS(rp), MON_TARGET, ref, prt->common.id, NIL);
erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK);
- ref_to_driver_monitor(ref,monitor);
+ erts_ref_to_driver_monitor(ref,monitor);
return 0;
}
@@ -7685,14 +7691,14 @@ static int do_driver_demonitor_process(Port *prt, const ErlDrvMonitor *monitor)
ErtsMonitor *mon;
Eterm to;
- ref = driver_monitor_to_ref(heap, monitor);
+ ref = erts_driver_monitor_to_ref(heap, monitor);
mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
if (mon == NULL) {
return 1;
}
ASSERT(mon->type == MON_ORIGIN);
- to = mon->pid;
+ to = mon->u.pid;
ASSERT(is_internal_pid(to));
rp = erts_pid2proc_opt(NULL,
0,
@@ -7742,14 +7748,14 @@ static ErlDrvTermData do_driver_get_monitored_process(Port *prt,const ErlDrvMoni
Eterm to;
Eterm heap[ERTS_REF_THING_SIZE];
- ref = driver_monitor_to_ref(heap, monitor);
+ ref = erts_driver_monitor_to_ref(heap, monitor);
mon = erts_lookup_monitor(ERTS_P_MONITORS(prt), ref);
if (mon == NULL) {
return driver_term_nil;
}
ASSERT(mon->type == MON_ORIGIN);
- to = mon->pid;
+ to = mon->u.pid;
ASSERT(is_internal_pid(to));
return (ErlDrvTermData) to;
}
@@ -7800,7 +7806,7 @@ void erts_fire_port_monitor(Port *prt, Eterm ref)
}
callback = prt->drv_ptr->process_exit;
ASSERT(callback != NULL);
- ref_to_driver_monitor(ref,&drv_monitor);
+ erts_ref_to_driver_monitor(ref,&drv_monitor);
ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT);
DRV_MONITOR_UNLOCK_PDL(prt);
#ifdef USE_VM_PROBES
diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c
index 44a77f3ea5..1ef9fa2a05 100644
--- a/erts/emulator/sys/common/erl_check_io.c
+++ b/erts/emulator/sys/common/erl_check_io.c
@@ -38,6 +38,7 @@
#include "erl_port.h"
#include "erl_check_io.h"
#include "erl_thr_progress.h"
+#include "erl_bif_unique.h"
#include "dtrace-wrapper.h"
#include "lttng-wrapper.h"
#define ERTS_WANT_TIMER_WHEEL_API
@@ -53,6 +54,8 @@ typedef char EventStateType;
#define ERTS_EV_TYPE_DRV_SEL ((EventStateType) 1) /* driver_select */
#define ERTS_EV_TYPE_DRV_EV ((EventStateType) 2) /* driver_event */
#define ERTS_EV_TYPE_STOP_USE ((EventStateType) 3) /* pending stop_select */
+#define ERTS_EV_TYPE_NIF ((EventStateType) 4) /* enif_select */
+#define ERTS_EV_TYPE_STOP_NIF ((EventStateType) 5) /* pending nif stop */
typedef char EventStateFlags;
#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */
@@ -122,7 +125,11 @@ typedef struct {
#if ERTS_CIO_HAVE_DRV_EVENT
ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */
#endif
- erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */
+ ErtsNifSelectDataState *nif; /* ERTS_EV_TYPE_NIF */
+ union {
+ erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */
+ ErtsResource* resource; /* ERTS_EV_TYPE_STOP_NIF */
+ }stop;
} driver;
ErtsPollEvents events;
unsigned short remove_cnt; /* number of removed_fd's referring to this fd */
@@ -194,7 +201,8 @@ static ERTS_INLINE ErtsDrvEventState* hash_new_drv_ev_state(ErtsSysFdType fd)
#if ERTS_CIO_HAVE_DRV_EVENT
tmpl.driver.event = NULL;
#endif
- tmpl.driver.drv_ptr = NULL;
+ tmpl.driver.nif = NULL;
+ tmpl.driver.stop.drv_ptr = NULL;
tmpl.events = 0;
tmpl.remove_cnt = 0;
tmpl.type = ERTS_EV_TYPE_NONE;
@@ -211,24 +219,35 @@ static ERTS_INLINE void hash_erase_drv_ev_state(ErtsDrvEventState *state)
#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */
static void stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode);
-static void select_steal(ErlDrvPort ix, ErtsDrvEventState *state,
- int mode, int on);
-static void print_select_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, int mode, int on);
+static void drv_select_steal(ErlDrvPort ix, ErtsDrvEventState *state,
+ int mode, int on);
+static void nif_select_steal(ErtsDrvEventState *state, int mode,
+ ErtsResource* resource, Eterm ref);
+
+static void print_drv_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, int mode, int on);
+static void print_nif_select_op(erts_dsprintf_buf_t*, ErtsSysFdType,
+ int mode, ErtsResource*, Eterm ref);
+
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
-static void select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int);
+static void drv_select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int);
+static void nif_select_large_fd_error(ErtsSysFdType, int, ErtsResource*,Eterm ref);
#endif
#if ERTS_CIO_HAVE_DRV_EVENT
-static void event_steal(ErlDrvPort ix, ErtsDrvEventState *state,
+static void drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state,
ErlDrvEventData event_data);
-static void print_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
+static void print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
static void event_large_fd_error(ErlDrvPort, ErtsSysFdType, ErlDrvEventData);
#endif
#endif
-static void steal_pending_stop_select(erts_dsprintf_buf_t*, ErlDrvPort,
- ErtsDrvEventState*, int mode, int on);
+static void
+steal_pending_stop_use(erts_dsprintf_buf_t*, ErlDrvPort, ErtsDrvEventState*,
+ int mode, int on);
+static void
+steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource*,
+ ErtsDrvEventState *state, int mode, int on);
#ifdef ERTS_SMP
ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(removed_fd, struct removed_fd, 64, ERTS_ALC_T_FD_LIST)
@@ -263,6 +282,18 @@ alloc_drv_select_data(void)
return dsp;
}
+static ERTS_INLINE ErtsNifSelectDataState *
+alloc_nif_select_data(void)
+{
+ ErtsNifSelectDataState *dsp = erts_alloc(ERTS_ALC_T_NIF_SEL_D_STATE,
+ sizeof(ErtsNifSelectDataState));
+ dsp->in.pid = NIL;
+ dsp->out.pid = NIL;
+ dsp->in.ddeselect_cnt = 0;
+ dsp->out.ddeselect_cnt = 0;
+ return dsp;
+}
+
static ERTS_INLINE void
free_drv_select_data(ErtsDrvSelectDataState *dsp)
{
@@ -271,6 +302,12 @@ free_drv_select_data(ErtsDrvSelectDataState *dsp)
erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, dsp);
}
+static ERTS_INLINE void
+free_nif_select_data(ErtsNifSelectDataState *dsp)
+{
+ erts_free(ERTS_ALC_T_NIF_SEL_D_STATE, dsp);
+}
+
#if ERTS_CIO_HAVE_DRV_EVENT
static ERTS_INLINE ErtsDrvEventDataState *
@@ -352,6 +389,7 @@ forget_removed(struct pollset_info* psi)
erts_smp_spin_unlock(&psi->removed_list_lock);
while (fdlp) {
+ ErtsResource* resource = NULL;
erts_driver_t* drv_ptr = NULL;
erts_smp_mtx_t* mtx;
ErtsSysFdType fd;
@@ -372,15 +410,25 @@ forget_removed(struct pollset_info* psi)
ASSERT(state->remove_cnt > 0);
if (--state->remove_cnt == 0) {
switch (state->type) {
+ case ERTS_EV_TYPE_STOP_NIF:
+ /* Now we can call stop */
+ resource = state->driver.stop.resource;
+ state->driver.stop.resource = NULL;
+ ASSERT(resource);
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ goto case_ERTS_EV_TYPE_NONE;
+
case ERTS_EV_TYPE_STOP_USE:
/* Now we can call stop_select */
- drv_ptr = state->driver.drv_ptr;
+ drv_ptr = state->driver.stop.drv_ptr;
ASSERT(drv_ptr);
state->type = ERTS_EV_TYPE_NONE;
state->flags &= ~ERTS_EV_FLAG_USED;
- state->driver.drv_ptr = NULL;
+ state->driver.stop.drv_ptr = NULL;
/* Fall through */
- case ERTS_EV_TYPE_NONE:
+ case ERTS_EV_TYPE_NONE:
+ case_ERTS_EV_TYPE_NONE:
#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
hash_erase_drv_ev_state(state);
#endif
@@ -403,6 +451,11 @@ forget_removed(struct pollset_info* psi)
erts_ddll_dereference_driver(drv_ptr->handle);
}
}
+ if (resource) {
+ erts_resource_stop(resource, (ErlNifEvent)fd, 0);
+ enif_release_resource(resource->data);
+ }
+
tofree = fdlp;
fdlp = fdlp->next;
removed_fd_free(tofree);
@@ -440,7 +493,8 @@ grow_drv_ev_state(int min_ix)
#if ERTS_CIO_HAVE_DRV_EVENT
drv_ev_state[i].driver.event = NULL;
#endif
- drv_ev_state[i].driver.drv_ptr = NULL;
+ drv_ev_state[i].driver.stop.drv_ptr = NULL;
+ drv_ev_state[i].driver.nif = NULL;
drv_ev_state[i].events = 0;
drv_ev_state[i].remove_cnt = 0;
drv_ev_state[i].type = ERTS_EV_TYPE_NONE;
@@ -480,6 +534,7 @@ abort_tasks(ErtsDrvEventState *state, int mode)
ERTS_EV_TYPE_DRV_EV);
return;
#endif
+ case ERTS_EV_TYPE_NIF:
case ERTS_EV_TYPE_NONE:
return;
default:
@@ -534,6 +589,14 @@ deselect(ErtsDrvEventState *state, int mode)
if (!(state->events)) {
switch (state->type) {
+ case ERTS_EV_TYPE_NIF:
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ enif_release_resource(state->driver.stop.resource);
+ state->driver.stop.resource = NULL;
+ break;
case ERTS_EV_TYPE_DRV_SEL:
state->driver.select->inport = NIL;
state->driver.select->outport = NIL;
@@ -569,7 +632,8 @@ check_fd_cleanup(ErtsDrvEventState *state,
#if ERTS_CIO_HAVE_DRV_EVENT
ErtsDrvEventDataState **free_event,
#endif
- ErtsDrvSelectDataState **free_select)
+ ErtsDrvSelectDataState **free_select,
+ ErtsNifSelectDataState **free_nif)
{
erts_aint_t current_cio_time;
@@ -586,6 +650,12 @@ check_fd_cleanup(ErtsDrvEventState *state,
state->driver.select = NULL;
}
+ *free_nif = NULL;
+ if (state->driver.nif && (state->type != ERTS_EV_TYPE_NIF)) {
+ *free_nif = state->driver.nif;
+ state->driver.nif = NULL;
+ }
+
#if ERTS_CIO_HAVE_DRV_EVENT
*free_event = NULL;
if (state->driver.event
@@ -617,12 +687,14 @@ check_cleanup_active_fd(ErtsSysFdType fd,
ErtsPollControlEntry *pce,
int *pce_ix,
#endif
- erts_aint_t current_cio_time)
+ erts_aint_t current_cio_time,
+ int may_sleep)
{
ErtsDrvEventState *state;
int active = 0;
erts_smp_mtx_t *mtx = fd_mtx(fd);
void *free_select = NULL;
+ void *free_nif = NULL;
#if ERTS_CIO_HAVE_DRV_EVENT
void *free_event = NULL;
#endif
@@ -682,6 +754,39 @@ check_cleanup_active_fd(ErtsSysFdType fd,
}
}
+ if (state->driver.nif) {
+ ErtsPollEvents rm_events = 0;
+ if (state->driver.nif->in.ddeselect_cnt) {
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->events & ERTS_POLL_EV_IN);
+ ASSERT(is_nil(state->driver.nif->in.pid));
+ if (may_sleep || state->driver.nif->in.ddeselect_cnt == 1) {
+ rm_events = ERTS_POLL_EV_IN;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ }
+ }
+ if (state->driver.nif->out.ddeselect_cnt) {
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->events & ERTS_POLL_EV_OUT);
+ ASSERT(is_nil(state->driver.nif->out.pid));
+ if (may_sleep || state->driver.nif->out.ddeselect_cnt == 1) {
+ rm_events |= ERTS_POLL_EV_OUT;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ }
+ }
+ if (rm_events) {
+ int do_wake = 0;
+ state->events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd,
+ rm_events, 0, &do_wake);
+ }
+ if (state->events)
+ active = 1;
+ else if (state->type != ERTS_EV_TYPE_NIF) {
+ free_nif = state->driver.nif;
+ state->driver.nif = NULL;
+ }
+ }
+
#if ERTS_CIO_HAVE_DRV_EVENT
if (state->driver.event) {
if (is_iotask_active(&state->driver.event->iotask, current_cio_time)) {
@@ -722,6 +827,8 @@ check_cleanup_active_fd(ErtsSysFdType fd,
if (free_select)
free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
#if ERTS_CIO_HAVE_DRV_EVENT
if (free_event)
free_drv_event_data(free_event);
@@ -746,7 +853,7 @@ check_cleanup_active_fd(ErtsSysFdType fd,
}
static void
-check_cleanup_active_fds(erts_aint_t current_cio_time)
+check_cleanup_active_fds(erts_aint_t current_cio_time, int may_sleep)
{
int six = pollset.active_fd.six;
int eix = pollset.active_fd.eix;
@@ -773,7 +880,8 @@ check_cleanup_active_fds(erts_aint_t current_cio_time)
pctrl_entries,
&pctrl_ix,
#endif
- current_cio_time)) {
+ current_cio_time,
+ may_sleep)) {
no--;
if (ix == six) {
#ifdef DEBUG
@@ -807,13 +915,30 @@ check_cleanup_active_fds(erts_aint_t current_cio_time)
erts_smp_atomic32_set_relb(&pollset.active_fd.no, no);
}
+static void grow_active_fds(void)
+{
+ ASSERT(pollset.active_fd.six == pollset.active_fd.eix);
+ pollset.active_fd.six = 0;
+ pollset.active_fd.eix = pollset.active_fd.size;
+ pollset.active_fd.size += ERTS_ACTIVE_FD_INC;
+ pollset.active_fd.array = erts_realloc(ERTS_ALC_T_ACTIVE_FD_ARR,
+ pollset.active_fd.array,
+ pollset.active_fd.size*sizeof(ErtsSysFdType));
+#ifdef DEBUG
+ {
+ int i;
+ for (i = pollset.active_fd.eix + 1; i < pollset.active_fd.size; i++)
+ pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
+ }
+#endif
+}
+
static ERTS_INLINE void
add_active_fd(ErtsSysFdType fd)
{
int eix = pollset.active_fd.eix;
int size = pollset.active_fd.size;
-
pollset.active_fd.array[eix] = fd;
erts_smp_atomic32_set_relb(&pollset.active_fd.no,
@@ -823,25 +948,11 @@ add_active_fd(ErtsSysFdType fd)
eix++;
if (eix >= size)
eix = 0;
- if (pollset.active_fd.six == eix) {
- pollset.active_fd.six = 0;
- eix = size;
- size += ERTS_ACTIVE_FD_INC;
- pollset.active_fd.array = erts_realloc(ERTS_ALC_T_ACTIVE_FD_ARR,
- pollset.active_fd.array,
- sizeof(ErtsSysFdType)*size);
- pollset.active_fd.size = size;
-#ifdef DEBUG
- {
- int i;
- for (i = eix + 1; i < size; i++)
- pollset.active_fd.array[i] = ERTS_SYS_FD_INVALID;
- }
-#endif
+ pollset.active_fd.eix = eix;
+ if (pollset.active_fd.six == eix) {
+ grow_active_fds();
}
-
- pollset.active_fd.eix = eix;
}
int
@@ -863,6 +974,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
ErtsDrvEventDataState *free_event = NULL;
#endif
ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
#ifdef USE_VM_PROBES
DTRACE_CHARBUF(name, 64);
#endif
@@ -878,7 +990,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
return -1;
}
if (fd >= max_fds) {
- select_large_fd_error(ix, fd, mode, on);
+ drv_select_large_fd_error(ix, fd, mode, on);
return -1;
}
grow_drv_ev_state(fd);
@@ -916,26 +1028,38 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
}
#endif
+ switch (state->type) {
#if ERTS_CIO_HAVE_DRV_EVENT
- if (state->type == ERTS_EV_TYPE_DRV_EV)
- select_steal(ix, state, mode, on);
+ case ERTS_EV_TYPE_DRV_EV:
#endif
- if (state->type == ERTS_EV_TYPE_STOP_USE) {
- erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, state->fd, mode, on);
- steal_pending_stop_select(dsbufp, ix, state, mode, on);
- if (state->type == ERTS_EV_TYPE_STOP_USE) {
- ret = 0;
- goto done; /* stop_select still pending */
- }
- ASSERT(state->type == ERTS_EV_TYPE_NONE);
- }
+ case ERTS_EV_TYPE_NIF:
+ drv_select_steal(ix, state, mode, on);
+ break;
+ case ERTS_EV_TYPE_STOP_USE: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal_pending_stop_use(dsbufp, ix, state, mode, on);
+ if (state->type == ERTS_EV_TYPE_STOP_USE) {
+ ret = 0;
+ goto done; /* stop_select still pending */
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+ }
+ case ERTS_EV_TYPE_STOP_NIF: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal_pending_stop_nif(dsbufp, NULL, state, mode, on);
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+
+ }}
if (mode & ERL_DRV_READ) {
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
Eterm owner = state->driver.select->inport;
if (owner != id && is_not_nil(owner))
- select_steal(ix, state, mode, on);
+ drv_select_steal(ix, state, mode, on);
}
ctl_events |= ERTS_POLL_EV_IN;
}
@@ -943,7 +1067,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
if (state->type == ERTS_EV_TYPE_DRV_SEL) {
Eterm owner = state->driver.select->outport;
if (owner != id && is_not_nil(owner))
- select_steal(ix, state, mode, on);
+ drv_select_steal(ix, state, mode, on);
}
ctl_events |= ERTS_POLL_EV_OUT;
}
@@ -1033,7 +1157,7 @@ ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix,
else {
/* Not safe to close fd, postpone stop_select callback. */
state->type = ERTS_EV_TYPE_STOP_USE;
- state->driver.drv_ptr = drv_ptr;
+ state->driver.stop.drv_ptr = drv_ptr;
if (drv_ptr->handle) {
erts_ddll_reference_referenced_driver(drv_ptr->handle);
}
@@ -1050,7 +1174,8 @@ done:
#if ERTS_CIO_HAVE_DRV_EVENT
&free_event,
#endif
- &free_select);
+ &free_select,
+ &free_nif);
done_unknown:
erts_smp_mtx_unlock(fd_mtx(fd));
@@ -1063,6 +1188,9 @@ done_unknown:
}
if (free_select)
free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+
#if ERTS_CIO_HAVE_DRV_EVENT
if (free_event)
free_drv_event_data(free_event);
@@ -1071,6 +1199,261 @@ done_unknown:
}
int
+ERTS_CIO_EXPORT(enif_select)(ErlNifEnv* env,
+ ErlNifEvent e,
+ enum ErlNifSelectFlags mode,
+ void* obj,
+ const ErlNifPid* pid,
+ Eterm ref)
+{
+ int on;
+ ErtsResource* resource = DATA_TO_RESOURCE(obj);
+ ErtsSysFdType fd = (ErtsSysFdType) e;
+ ErtsPollEvents ctl_events = (ErtsPollEvents) 0;
+ ErtsPollEvents new_events, old_events;
+ ErtsDrvEventState *state;
+ int wake_poller;
+ int ret;
+ enum { NO_STOP=0, CALL_STOP, CALL_STOP_AND_RELEASE } call_stop = NO_STOP;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ ErtsDrvEventDataState *free_event = NULL;
+#endif
+ ErtsDrvSelectDataState *free_select = NULL;
+ ErtsNifSelectDataState *free_nif = NULL;
+#ifdef USE_VM_PROBES
+ DTRACE_CHARBUF(name, 64);
+#endif
+
+ ASSERT(!(resource->monitors && resource->monitors->is_dying));
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if ((unsigned)fd >= (unsigned)erts_smp_atomic_read_nob(&drv_ev_state_len)) {
+ if (fd < 0) {
+ return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
+ }
+ if (fd >= max_fds) {
+ nif_select_large_fd_error(fd, mode, resource, ref);
+ return INT_MIN | ERL_NIF_SELECT_INVALID_EVENT;
+ }
+ grow_drv_ev_state(fd);
+ }
+#endif
+
+ erts_smp_mtx_lock(fd_mtx(fd));
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ state = &drv_ev_state[(int) fd];
+#else
+ state = hash_get_drv_ev_state(fd); /* may be NULL! */
+#endif
+
+ if (mode & ERL_NIF_SELECT_STOP) {
+ ASSERT(resource->type->stop);
+ if (IS_FD_UNKNOWN(state)) {
+ /* fast track to stop callback */
+ call_stop = CALL_STOP;
+ ret = ERL_NIF_SELECT_STOP_CALLED;
+ goto done_unknown;
+ }
+ on = 0;
+ mode = ERL_DRV_READ | ERL_DRV_WRITE | ERL_DRV_USE;
+ wake_poller = 1; /* to eject fd from pollset (if needed) */
+ ctl_events = ERTS_POLL_EV_IN | ERTS_POLL_EV_OUT;
+ }
+ else {
+ on = 1;
+ ASSERT(mode);
+ wake_poller = 0;
+ if (mode & ERL_DRV_READ) {
+ ctl_events |= ERTS_POLL_EV_IN;
+ }
+ if (mode & ERL_DRV_WRITE) {
+ ctl_events |= ERTS_POLL_EV_OUT;
+ }
+ }
+
+#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (state == NULL) {
+ state = hash_new_drv_ev_state(fd);
+ }
+#endif
+
+ switch (state->type) {
+ case ERTS_EV_TYPE_NIF:
+ /*
+ * Changing resource is considered stealing.
+ * Changing process and/or ref is ok (I think?).
+ */
+ if (state->driver.stop.resource != resource)
+ nif_select_steal(state, ERL_DRV_READ | ERL_DRV_WRITE, resource, ref);
+ break;
+#if ERTS_CIO_HAVE_DRV_EVENT
+ case ERTS_EV_TYPE_DRV_EV:
+#endif
+ case ERTS_EV_TYPE_DRV_SEL:
+ nif_select_steal(state, mode, resource, ref);
+ break;
+ case ERTS_EV_TYPE_STOP_USE: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
+ steal_pending_stop_use(dsbufp, ERTS_INVALID_ERL_DRV_PORT, state, mode, on);
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+ }
+ case ERTS_EV_TYPE_STOP_NIF: {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
+ steal_pending_stop_nif(dsbufp, resource, state, mode, on);
+ if (state->type == ERTS_EV_TYPE_STOP_NIF) {
+ ret = ERL_NIF_SELECT_STOP_SCHEDULED; /* ?? */
+ goto done;
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NONE);
+ break;
+ }}
+
+ ASSERT((state->type == ERTS_EV_TYPE_NIF) ||
+ (state->type == ERTS_EV_TYPE_NONE && !state->events));
+
+ new_events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, ctl_events, on, &wake_poller);
+
+ if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) {
+ if (state->type == ERTS_EV_TYPE_NIF && !state->events) {
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ state->driver.stop.resource = NULL;
+ }
+ ret = INT_MIN | ERL_NIF_SELECT_FAILED;
+ goto done;
+ }
+
+ old_events = state->events;
+
+ ASSERT(on
+ ? (new_events == (state->events | ctl_events))
+ : (new_events == (state->events & ~ctl_events)));
+
+ ASSERT(state->type == ERTS_EV_TYPE_NIF
+ || state->type == ERTS_EV_TYPE_NONE);
+
+ state->events = new_events;
+ if (on) {
+ const Eterm recipient = pid ? pid->pid : env->proc->common.id;
+ Uint32* refn;
+ if (!state->driver.nif)
+ state->driver.nif = alloc_nif_select_data();
+ if (state->type == ERTS_EV_TYPE_NONE) {
+ state->type = ERTS_EV_TYPE_NIF;
+ state->driver.stop.resource = resource;
+ enif_keep_resource(resource->data);
+ }
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->driver.stop.resource == resource);
+ if (ctl_events & ERTS_POLL_EV_IN) {
+ state->driver.nif->in.pid = recipient;
+ if (is_immed(ref)) {
+ state->driver.nif->in.immed = ref;
+ } else {
+ ASSERT(is_internal_ref(ref));
+ refn = internal_ref_numbers(ref);
+ state->driver.nif->in.immed = THE_NON_VALUE;
+ state->driver.nif->in.refn[0] = refn[0];
+ state->driver.nif->in.refn[1] = refn[1];
+ state->driver.nif->in.refn[2] = refn[2];
+ }
+ state->driver.nif->in.ddeselect_cnt = 0;
+ }
+ if (ctl_events & ERTS_POLL_EV_OUT) {
+ state->driver.nif->out.pid = recipient;
+ if (is_immed(ref)) {
+ state->driver.nif->out.immed = ref;
+ } else {
+ ASSERT(is_internal_ref(ref));
+ refn = internal_ref_numbers(ref);
+ state->driver.nif->out.immed = THE_NON_VALUE;
+ state->driver.nif->out.refn[0] = refn[0];
+ state->driver.nif->out.refn[1] = refn[1];
+ state->driver.nif->out.refn[2] = refn[2];
+ }
+ state->driver.nif->out.ddeselect_cnt = 0;
+ }
+ ret = 0;
+ }
+ else { /* off */
+ if (state->type == ERTS_EV_TYPE_NIF) {
+ state->driver.nif->in.pid = NIL;
+ state->driver.nif->out.pid = NIL;
+ state->driver.nif->in.ddeselect_cnt = 0;
+ state->driver.nif->out.ddeselect_cnt = 0;
+ if (old_events != 0) {
+ remember_removed(state, &pollset);
+ }
+ }
+ ASSERT(new_events==0);
+ if (state->remove_cnt == 0 || !wake_poller) {
+ /*
+ * Safe to close fd now as it is not in pollset
+ * or there was no need to eject fd (kernel poll)
+ */
+ if (state->type == ERTS_EV_TYPE_NIF) {
+ ASSERT(state->driver.stop.resource == resource);
+ call_stop = CALL_STOP_AND_RELEASE;
+ state->driver.stop.resource = NULL;
+ }
+ else {
+ ASSERT(!state->driver.stop.resource);
+ call_stop = CALL_STOP;
+ }
+ state->type = ERTS_EV_TYPE_NONE;
+ ret = ERL_NIF_SELECT_STOP_CALLED;
+ }
+ else {
+ /* Not safe to close fd, postpone stop_select callback. */
+ if (state->type == ERTS_EV_TYPE_NONE) {
+ ASSERT(!state->driver.stop.resource);
+ state->driver.stop.resource = resource;
+ enif_keep_resource(resource);
+ }
+ state->type = ERTS_EV_TYPE_STOP_NIF;
+ ret = ERL_NIF_SELECT_STOP_SCHEDULED;
+ }
+ }
+
+done:
+
+ check_fd_cleanup(state,
+#if ERTS_CIO_HAVE_DRV_EVENT
+ &free_event,
+#endif
+ &free_select,
+ &free_nif);
+
+done_unknown:
+ erts_smp_mtx_unlock(fd_mtx(fd));
+ if (call_stop) {
+ erts_resource_stop(resource, (ErlNifEvent)fd, 1);
+ if (call_stop == CALL_STOP_AND_RELEASE) {
+ enif_release_resource(resource->data);
+ }
+ }
+ if (free_select)
+ free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
+
+#if ERTS_CIO_HAVE_DRV_EVENT
+ if (free_event)
+ free_drv_event_data(free_event);
+#endif
+ return ret;
+}
+
+
+int
ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
ErlDrvEvent e,
ErlDrvEventData event_data)
@@ -1090,6 +1473,7 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
ErtsDrvEventDataState *free_event;
#endif
ErtsDrvSelectDataState *free_select;
+ ErtsNifSelectDataState *free_nif;
Port *prt = erts_drvport2port(ix);
if (prt == ERTS_INVALID_ERL_DRV_PORT)
@@ -1126,12 +1510,12 @@ ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix,
if (state->driver.event->port == id) break;
/*fall through*/
case ERTS_EV_TYPE_DRV_SEL:
- event_steal(ix, state, event_data);
+ drv_event_steal(ix, state, event_data);
break;
case ERTS_EV_TYPE_STOP_USE: {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, fd, event_data);
- steal_pending_stop_select(dsbufp, ix, state, 0, 1);
+ print_drv_event_op(dsbufp, ix, fd, event_data);
+ steal_pending_stop_use(dsbufp, ix, state, 0, 1);
break;
}
}
@@ -1199,12 +1583,15 @@ done:
#if ERTS_CIO_HAVE_DRV_EVENT
&free_event,
#endif
- &free_select);
+ &free_select,
+ &free_nif);
erts_smp_mtx_unlock(fd_mtx(fd));
if (free_select)
free_drv_select_data(free_select);
+ if (free_nif)
+ free_nif_select_data(free_nif);
#if ERTS_CIO_HAVE_DRV_EVENT
if (free_event)
free_drv_event_data(free_event);
@@ -1240,13 +1627,19 @@ need2steal(ErtsDrvEventState *state, int mode)
state,
ERL_DRV_WRITE);
break;
+ case ERTS_EV_TYPE_NIF:
+ ASSERT(state->driver.stop.resource);
+ do_steal = 1;
+ break;
+
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV:
do_steal |= chk_stale(state->driver.event->port, state, 0);
break;
#endif
case ERTS_EV_TYPE_STOP_USE:
- ASSERT(0);
+ case ERTS_EV_TYPE_STOP_NIF:
+ ASSERT(0);
break;
default:
break;
@@ -1307,6 +1700,25 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
erts_dsprintf(dsbufp, "\n");
break;
}
+ case ERTS_EV_TYPE_NIF: {
+ Eterm iid = state->driver.nif->in.pid;
+ Eterm oid = state->driver.nif->out.pid;
+ const char* with = "with";
+ ErlNifResourceType* rt = state->driver.stop.resource->type;
+
+ erts_dsprintf(dsbufp, "resource %T:%T", rt->module, rt->name);
+
+ if (is_not_nil(iid)) {
+ erts_dsprintf(dsbufp, " %s in-pid %T", with, iid);
+ with = "and";
+ }
+ if (is_not_nil(oid)) {
+ erts_dsprintf(dsbufp, " %s out-pid %T", with, oid);
+ }
+ deselect(state, 0);
+ erts_dsprintf(dsbufp, "\n");
+ break;
+ }
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV: {
Eterm eid = state->driver.event->port;
@@ -1324,7 +1736,8 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
break;
}
#endif
- case ERTS_EV_TYPE_STOP_USE: {
+ case ERTS_EV_TYPE_STOP_USE:
+ case ERTS_EV_TYPE_STOP_NIF: {
ASSERT(0);
break;
}
@@ -1335,8 +1748,8 @@ steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode)
}
static void
-print_select_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
+print_drv_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
{
Port *pp = erts_drvport2port(ix);
erts_dsprintf(dsbufp,
@@ -1354,11 +1767,40 @@ print_select_op(erts_dsprintf_buf_t *dsbufp,
}
static void
-select_steal(ErlDrvPort ix, ErtsDrvEventState *state, int mode, int on)
+print_nif_select_op(erts_dsprintf_buf_t *dsbufp,
+ ErtsSysFdType fd, int mode,
+ ErtsResource* resource, Eterm ref)
+{
+ erts_dsprintf(dsbufp,
+ "enif_select(_, %d,%s%s%s, %T:%T, %T) ",
+ (int) GET_FD(fd),
+ mode & ERL_NIF_SELECT_READ ? " READ" : "",
+ mode & ERL_NIF_SELECT_WRITE ? " WRITE" : "",
+ mode & ERL_NIF_SELECT_STOP ? " STOP" : "",
+ resource->type->module,
+ resource->type->name,
+ ref);
+}
+
+
+static void
+drv_select_steal(ErlDrvPort ix, ErtsDrvEventState *state, int mode, int on)
{
if (need2steal(state, mode)) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, state->fd, mode, on);
+ print_drv_select_op(dsbufp, ix, state->fd, mode, on);
+ steal(dsbufp, state, mode);
+ erts_send_error_to_logger_nogl(dsbufp);
+ }
+}
+
+static void
+nif_select_steal(ErtsDrvEventState *state, int mode,
+ ErtsResource* resource, Eterm ref)
+{
+ if (need2steal(state, mode)) {
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, state->fd, mode, resource, ref);
steal(dsbufp, state, mode);
erts_send_error_to_logger_nogl(dsbufp);
}
@@ -1374,10 +1816,20 @@ large_fd_error_common(erts_dsprintf_buf_t *dsbufp, ErtsSysFdType fd)
}
static void
-select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
+drv_select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
{
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_select_op(dsbufp, ix, fd, mode, on);
+ print_drv_select_op(dsbufp, ix, fd, mode, on);
+ erts_dsprintf(dsbufp, "failed: ");
+ large_fd_error_common(dsbufp, fd);
+ erts_send_error_to_logger_nogl(dsbufp);
+}
+static void
+nif_select_large_fd_error(ErtsSysFdType fd, int mode,
+ ErtsResource* resource, Eterm ref)
+{
+ erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
+ print_nif_select_op(dsbufp, fd, mode, resource, ref);
erts_dsprintf(dsbufp, "failed: ");
large_fd_error_common(dsbufp, fd);
erts_send_error_to_logger_nogl(dsbufp);
@@ -1387,41 +1839,81 @@ select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on)
static void
-steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
- ErtsDrvEventState *state, int mode, int on)
+steal_pending_stop_use(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
+ ErtsDrvEventState *state, int mode, int on)
{
+ int cancel = 0;
ASSERT(state->type == ERTS_EV_TYPE_STOP_USE);
- erts_dsprintf(dsbufp, "failed: fd=%d (re)selected before stop_select "
- "was called for driver %s\n",
- (int) GET_FD(state->fd), state->driver.drv_ptr->name);
- erts_send_error_to_logger_nogl(dsbufp);
if (on) {
/* Either fd-owner changed its mind about closing
* or closed fd before stop_select callback and fd is now reused.
* In either case stop_select should not be called.
- */
- state->type = ERTS_EV_TYPE_NONE;
- state->flags &= ~ERTS_EV_FLAG_USED;
- if (state->driver.drv_ptr->handle) {
- erts_ddll_dereference_driver(state->driver.drv_ptr->handle);
- }
- state->driver.drv_ptr = NULL;
+ */
+ cancel = 1;
}
else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) {
Port *prt = erts_drvport2port(ix);
- erts_driver_t* drv_ptr = prt != ERTS_INVALID_ERL_DRV_PORT ? prt->drv_ptr : NULL;
- if (drv_ptr && drv_ptr != state->driver.drv_ptr) {
- /* Some other driver wants the stop_select callback */
- if (state->driver.drv_ptr->handle) {
- erts_ddll_dereference_driver(state->driver.drv_ptr->handle);
- }
- if (drv_ptr->handle) {
- erts_ddll_reference_referenced_driver(drv_ptr->handle);
- }
- state->driver.drv_ptr = drv_ptr;
- }
+ if (prt == ERTS_INVALID_ERL_DRV_PORT
+ || prt->drv_ptr != state->driver.stop.drv_ptr) {
+ /* Some other driver or nif wants the stop_select callback */
+ cancel = 1;
+ }
+ }
+
+ if (cancel) {
+ erts_dsprintf(dsbufp, "called before stop_select was called for driver '%s'\n",
+ state->driver.stop.drv_ptr->name);
+ if (state->driver.stop.drv_ptr->handle) {
+ erts_ddll_dereference_driver(state->driver.stop.drv_ptr->handle);
+ }
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.stop.drv_ptr = NULL;
}
+ else {
+ erts_dsprintf(dsbufp, "ignored repeated call\n");
+ }
+ erts_send_error_to_logger_nogl(dsbufp);
+}
+
+static void
+steal_pending_stop_nif(erts_dsprintf_buf_t *dsbufp, ErtsResource* resource,
+ ErtsDrvEventState *state, int mode, int on)
+{
+ int cancel = 0;
+
+ ASSERT(state->type == ERTS_EV_TYPE_STOP_NIF);
+ ASSERT(state->driver.stop.resource);
+
+ if (on) {
+ ASSERT(mode & (ERL_NIF_SELECT_READ | ERL_NIF_SELECT_WRITE));
+ /* Either fd-owner changed its mind about closing
+ * or closed fd before stop callback and fd is now reused.
+ * In either case, stop should not be called.
+ */
+ cancel = 1;
+ }
+ else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE
+ && resource != state->driver.stop.resource) {
+ /* Some driver or other resource wants the stop callback */
+ cancel = 1;
+ }
+
+ if (cancel) {
+ ErlNifResourceType* rt = state->driver.stop.resource->type;
+ erts_dsprintf(dsbufp, "called before stop was called for NIF resource %T:%T\n",
+ rt->module, rt->name);
+
+ enif_release_resource(state->driver.stop.resource);
+ state->type = ERTS_EV_TYPE_NONE;
+ state->flags &= ~ERTS_EV_FLAG_USED;
+ state->driver.stop.resource = NULL;
+ }
+ else {
+ erts_dsprintf(dsbufp, "ignored repeated call\n");
+ }
+ erts_send_error_to_logger_nogl(dsbufp);
}
@@ -1429,8 +1921,8 @@ steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix,
#if ERTS_CIO_HAVE_DRV_EVENT
static void
-print_event_op(erts_dsprintf_buf_t *dsbufp,
- ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
+print_drv_event_op(erts_dsprintf_buf_t *dsbufp,
+ ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
{
Port *pp = erts_drvport2port(ix);
erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd);
@@ -1447,11 +1939,11 @@ print_event_op(erts_dsprintf_buf_t *dsbufp,
}
static void
-event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data)
+drv_event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data)
{
if (need2steal(state, ERL_DRV_READ|ERL_DRV_WRITE)) {
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, state->fd, event_data);
+ print_drv_event_op(dsbufp, ix, state->fd, event_data);
steal(dsbufp, state, ERL_DRV_READ|ERL_DRV_WRITE);
erts_send_error_to_logger_nogl(dsbufp);
}
@@ -1466,7 +1958,7 @@ static void
event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data)
{
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
- print_event_op(dsbufp, ix, fd, event_data);
+ print_drv_event_op(dsbufp, ix, fd, event_data);
erts_dsprintf(dsbufp, "failed: ");
large_fd_error_common(dsbufp, fd);
erts_send_error_to_logger_nogl(dsbufp);
@@ -1553,6 +2045,55 @@ oready(Eterm id, ErtsDrvEventState *state, erts_aint_t current_cio_time)
}
}
+static ERTS_INLINE void
+send_event_tuple(struct erts_nif_select_event* e, ErtsResource* resource,
+ Eterm event_atom)
+{
+ Process* rp = erts_proc_lookup(e->pid);
+ ErtsProcLocks rp_locks = 0;
+ ErtsMessage* mp;
+ ErlOffHeap* ohp;
+ ErtsBinary* bin;
+ Eterm* hp;
+ Uint hsz;
+ Eterm resource_term, ref_term, tuple;
+
+ if (!rp) {
+ return;
+ }
+
+ bin = ERTS_MAGIC_BIN_FROM_UNALIGNED_DATA(resource);
+
+ /* {select, Resource, Ref, EventAtom} */
+ if (is_value(e->immed)) {
+ hsz = 5 + ERTS_MAGIC_REF_THING_SIZE;
+ }
+ else {
+ hsz = 5 + ERTS_MAGIC_REF_THING_SIZE + ERTS_REF_THING_SIZE;
+ }
+
+ mp = erts_alloc_message_heap(rp, &rp_locks, hsz, &hp, &ohp);
+
+ resource_term = erts_mk_magic_ref(&hp, ohp, &bin->binary);
+ if (is_value(e->immed)) {
+ ASSERT(is_immed(e->immed));
+ ref_term = e->immed;
+ }
+ else {
+ write_ref_thing(hp, e->refn[0], e->refn[1], e->refn[2]);
+ ref_term = make_internal_ref(hp);
+ hp += ERTS_REF_THING_SIZE;
+ }
+ tuple = TUPLE4(hp, am_select, resource_term, ref_term, event_atom);
+
+ ERL_MESSAGE_TOKEN(mp) = am_undefined;
+ erts_queue_message(rp, rp_locks, mp, tuple, am_system);
+
+ if (rp_locks)
+ erts_smp_proc_unlock(rp, rp_locks);
+}
+
+
#if ERTS_CIO_HAVE_DRV_EVENT
static ERTS_INLINE void
eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data,
@@ -1575,7 +2116,7 @@ eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data,
}
#endif
-static void bad_fd_in_pollset( ErtsDrvEventState *, Eterm, Eterm, ErtsPollEvents);
+static void bad_fd_in_pollset(ErtsDrvEventState *, Eterm inport, Eterm outport);
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
void
@@ -1598,6 +2139,17 @@ ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set,
ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, timeout_time);
}
+#if !ERTS_CIO_DEFER_ACTIVE_EVENTS
+/*
+ * Number of ignored events, for a lingering fd added by enif_select(),
+ * until we deselect fd-event from pollset.
+ */
+# define ERTS_NIF_DELAYED_DESELECT 20
+#else
+/* Disable delayed deselect as pollset cannot handle active events */
+# define ERTS_NIF_DELAYED_DESELECT 1
+#endif
+
void
ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
{
@@ -1631,7 +2183,8 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
current_cio_time++;
erts_smp_atomic_set_relb(&erts_check_io_time, current_cio_time);
- check_cleanup_active_fds(current_cio_time);
+ check_cleanup_active_fds(current_cio_time,
+ timeout_time != ERTS_POLL_NO_TIMEOUT);
#ifdef ERTS_ENABLE_LOCK_CHECK
erts_lc_check_exact(NULL, 0); /* No locks should be locked */
@@ -1699,31 +2252,22 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
switch (state->type) {
case ERTS_EV_TYPE_DRV_SEL: { /* Requested via driver_select()... */
- ErtsPollEvents revents;
- ErtsPollEvents revent_mask;
-
- revent_mask = ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT);
- revent_mask |= state->events;
- revents = pollres[i].events & revent_mask;
-
- if (revents & ERTS_POLL_EV_ERR) {
- /*
- * Let the driver handle the error condition. Only input,
- * only output, or nothing might have been selected.
- * We *do not* want to call a callback that corresponds
- * to an event not selected. revents might give us a clue
- * on which one to call.
- */
- if ((revents & ERTS_POLL_EV_IN)
- || (!(revents & ERTS_POLL_EV_OUT)
- && state->events & ERTS_POLL_EV_IN)) {
- iready(state->driver.select->inport, state, current_cio_time);
- }
- else if (state->events & ERTS_POLL_EV_OUT) {
- oready(state->driver.select->outport, state, current_cio_time);
- }
- }
- else if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
+ ErtsPollEvents revents = pollres[i].events;
+
+ if (revents & ERTS_POLL_EV_ERR) {
+ /*
+ * Handle error events by triggering all in/out events
+ * that the driver has selected.
+ * We *do not* want to call a callback that corresponds
+ * to an event not selected.
+ */
+ revents = state->events;
+ }
+ else {
+ revents &= (state->events | ERTS_POLL_EV_NVAL);
+ }
+
+ if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
if (revents & ERTS_POLL_EV_OUT) {
oready(state->driver.select->outport, state, current_cio_time);
}
@@ -1731,21 +2275,84 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
was read (true also on the non-smp emulator since
oready() may have been called); therefore, update
revents... */
- revents &= ~(~state->events & ERTS_POLL_EV_IN);
+ revents &= state->events;
if (revents & ERTS_POLL_EV_IN) {
iready(state->driver.select->inport, state, current_cio_time);
}
}
else if (revents & ERTS_POLL_EV_NVAL) {
bad_fd_in_pollset(state,
- state->driver.select->inport,
- state->driver.select->outport,
- state->events);
+ state->driver.select->inport,
+ state->driver.select->outport);
add_active_fd(state->fd);
}
break;
}
+ case ERTS_EV_TYPE_NIF: { /* Requested via enif_select()... */
+ struct erts_nif_select_event in = {NIL};
+ struct erts_nif_select_event out = {NIL};
+ ErtsResource* resource;
+ ErtsPollEvents revents = pollres[i].events;
+
+ if (revents & ERTS_POLL_EV_ERR) {
+ /*
+ * Handle error events by triggering all in/out events
+ * that the NIF has selected.
+ * We *do not* want to send a message that corresponds
+ * to an event not selected.
+ */
+ revents = state->events;
+ }
+ else {
+ revents &= (state->events | ERTS_POLL_EV_NVAL);
+ }
+
+ if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
+ if (revents & ERTS_POLL_EV_OUT) {
+ if (is_not_nil(state->driver.nif->out.pid)) {
+ out = state->driver.nif->out;
+ resource = state->driver.stop.resource;
+ state->driver.nif->out.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
+ state->driver.nif->out.pid = NIL;
+ add_active_fd(state->fd);
+ }
+ else {
+ ASSERT(state->driver.nif->out.ddeselect_cnt >= 2);
+ state->driver.nif->out.ddeselect_cnt--;
+ }
+ }
+ if (revents & ERTS_POLL_EV_IN) {
+ if (is_not_nil(state->driver.nif->in.pid)) {
+ in = state->driver.nif->in;
+ resource = state->driver.stop.resource;
+ state->driver.nif->in.ddeselect_cnt = ERTS_NIF_DELAYED_DESELECT;
+ state->driver.nif->in.pid = NIL;
+ add_active_fd(state->fd);
+ }
+ else {
+ ASSERT(state->driver.nif->in.ddeselect_cnt >= 2);
+ state->driver.nif->in.ddeselect_cnt--;
+ }
+ }
+ }
+ else if (revents & ERTS_POLL_EV_NVAL) {
+ bad_fd_in_pollset(state, NIL, NIL);
+ add_active_fd(state->fd);
+ }
+
+#ifdef ERTS_SMP
+ erts_smp_mtx_unlock(fd_mtx(fd));
+#endif
+ if (is_not_nil(in.pid)) {
+ send_event_tuple(&in, resource, am_ready_input);
+ }
+ if (is_not_nil(out.pid)) {
+ send_event_tuple(&out, resource, am_ready_output);
+ }
+ goto next_pollres_unlocked;
+ }
+
#if ERTS_CIO_HAVE_DRV_EVENT
case ERTS_EV_TYPE_DRV_EV: { /* Requested via driver_event()... */
ErlDrvEventData event_data;
@@ -1786,6 +2393,7 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
#ifdef ERTS_SMP
erts_smp_mtx_unlock(fd_mtx(fd));
#endif
+ next_pollres_unlocked:;
}
erts_smp_atomic_set_nob(&pollset.in_poll_wait, 0);
@@ -1794,9 +2402,9 @@ ERTS_CIO_EXPORT(erts_check_io)(int do_wait)
}
static void
-bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
- Eterm outport, ErtsPollEvents events)
+bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, Eterm outport)
{
+ ErtsPollEvents events = state->events;
erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf();
if (events & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) {
@@ -1820,27 +2428,36 @@ bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport,
erts_dsprintf(dsbufp,
"Bad %s fd in erts_poll()! fd=%d, ",
io_str, (int) state->fd);
- if (is_nil(port)) {
- ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
- ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
- erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
- is_nil(inport) ? am_undefined : inport,
- is_nil(outport) ? am_undefined : outport,
- ipnp->driver_name ? ipnp->driver_name : "<unknown>",
- opnp->driver_name ? opnp->driver_name : "<unknown>",
- ipnp->name ? ipnp->name : "<unknown>",
- opnp->name ? opnp->name : "<unknown>");
- erts_free_port_names(ipnp);
- erts_free_port_names(opnp);
- }
- else {
- ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
- erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
- is_nil(port) ? am_undefined : port,
- pnp->driver_name ? pnp->driver_name : "<unknown>",
- pnp->name ? pnp->name : "<unknown>");
- erts_free_port_names(pnp);
- }
+ if (state->type == ERTS_EV_TYPE_DRV_SEL) {
+ if (is_nil(port)) {
+ ErtsPortNames *ipnp = erts_get_port_names(inport, ERTS_INVALID_ERL_DRV_PORT);
+ ErtsPortNames *opnp = erts_get_port_names(outport, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n",
+ is_nil(inport) ? am_undefined : inport,
+ is_nil(outport) ? am_undefined : outport,
+ ipnp->driver_name ? ipnp->driver_name : "<unknown>",
+ opnp->driver_name ? opnp->driver_name : "<unknown>",
+ ipnp->name ? ipnp->name : "<unknown>",
+ opnp->name ? opnp->name : "<unknown>");
+ erts_free_port_names(ipnp);
+ erts_free_port_names(opnp);
+ }
+ else {
+ ErtsPortNames *pnp = erts_get_port_names(port, ERTS_INVALID_ERL_DRV_PORT);
+ erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n",
+ is_nil(port) ? am_undefined : port,
+ pnp->driver_name ? pnp->driver_name : "<unknown>",
+ pnp->name ? pnp->name : "<unknown>");
+ erts_free_port_names(pnp);
+ }
+ }
+ else {
+ ErlNifResourceType* rt;
+ ASSERT(state->type == ERTS_EV_TYPE_NIF);
+ ASSERT(state->driver.stop.resource);
+ rt = state->driver.stop.resource->type;
+ erts_dsprintf(dsbufp, "resource={%T,%T}\n", rt->module, rt->name);
+ }
}
else {
erts_dsprintf(dsbufp, "Bad fd in erts_poll()! fd=%d\n", (int) state->fd);
@@ -1905,6 +2522,10 @@ static void drv_ev_state_free(void *des)
void
ERTS_CIO_EXPORT(erts_init_check_io)(void)
{
+ ERTS_CT_ASSERT((INT_MIN & (ERL_NIF_SELECT_STOP_CALLED |
+ ERL_NIF_SELECT_STOP_SCHEDULED |
+ ERL_NIF_SELECT_INVALID_EVENT |
+ ERL_NIF_SELECT_FAILED)) == 0);
erts_smp_atomic_init_nob(&erts_check_io_time, 0);
erts_smp_atomic_init_nob(&pollset.in_poll_wait, 0);
@@ -2311,6 +2932,39 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
}
}
}
+ else if (state->type == ERTS_EV_TYPE_NIF) {
+ ErtsResource* r;
+ erts_printf("enif_select ");
+
+#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
+ if (internal) {
+ erts_printf("internal ");
+ err = 1;
+ }
+
+ if (cio_events == ep_events) {
+ erts_printf("ev=");
+ if (print_events(cio_events) != 0)
+ err = 1;
+ }
+ else {
+ err = 1;
+ erts_printf("cio_ev=");
+ print_events(cio_events);
+ erts_printf(" ep_ev=");
+ print_events(ep_events);
+ }
+#else
+ if (print_events(cio_events) != 0)
+ err = 1;
+#endif
+ erts_printf(" inpid=%T dd_cnt=%b32d", state->driver.nif->in.pid,
+ state->driver.nif->in.ddeselect_cnt);
+ erts_printf(" outpid=%T dd_cnt=%b32d", state->driver.nif->out.pid,
+ state->driver.nif->out.ddeselect_cnt);
+ r = state->driver.stop.resource;
+ erts_printf(" resource=%p(%T:%T)", r, r->type->module, r->type->name);
+ }
#if ERTS_CIO_HAVE_DRV_EVENT
else if (state->type == ERTS_EV_TYPE_DRV_EV) {
Eterm id;
@@ -2367,11 +3021,12 @@ static void doit_erts_check_io_debug(void *vstate, void *vcounters)
erts_printf("control_type=%d ", (int)state->type);
#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS
if (cio_events == ep_events) {
- erts_printf("ev=0x%b32x", (Uint32) cio_events);
+ erts_printf("ev=");
+ print_events(cio_events);
}
else {
- erts_printf("cio_ev=0x%b32x", (Uint32) cio_events);
- erts_printf(" ep_ev=0x%b32x", (Uint32) ep_events);
+ erts_printf("cio_ev="); print_events(cio_events);
+ erts_printf(" ep_ev="); print_events(ep_events);
}
#else
erts_printf("ev=0x%b32x", (Uint32) cio_events);
@@ -2400,7 +3055,7 @@ ERTS_CIO_EXPORT(erts_check_io_debug)(ErtsCheckIoDebugInfo *ciodip)
#if ERTS_CIO_HAVE_DRV_EVENT
null_des.driver.event = NULL;
#endif
- null_des.driver.drv_ptr = NULL;
+ null_des.driver.stop.drv_ptr = NULL;
null_des.events = 0;
null_des.remove_cnt = 0;
null_des.type = ERTS_EV_TYPE_NONE;
diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h
index 14f1ea3f43..f02d6c1f62 100644
--- a/erts/emulator/sys/common/erl_check_io.h
+++ b/erts/emulator/sys/common/erl_check_io.h
@@ -34,6 +34,8 @@
int driver_select_kp(ErlDrvPort, ErlDrvEvent, int, int);
int driver_select_nkp(ErlDrvPort, ErlDrvEvent, int, int);
+int enif_select_kp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
+int enif_select_nkp(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
int driver_event_kp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
int driver_event_nkp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
Uint erts_check_io_size_kp(void);
@@ -136,4 +138,20 @@ typedef struct {
ErtsIoTask iniotask;
ErtsIoTask outiotask;
} ErtsDrvSelectDataState;
+
+struct erts_nif_select_event {
+ Eterm pid;
+ Eterm immed;
+ Uint32 refn[ERTS_REF_NUMBERS];
+ Sint32 ddeselect_cnt; /* 0: No delayed deselect in progress
+ * 1: Do deselect before next poll
+ * >1: Countdown of ignored events
+ */
+};
+
+typedef struct {
+ struct erts_nif_select_event in;
+ struct erts_nif_select_event out;
+} ErtsNifSelectDataState;
+
#endif /* #ifndef ERL_CHECK_IO_INTERNAL__ */
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index cb20c690b4..0d1ed17449 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -151,6 +151,7 @@ int erts_use_kernel_poll = 0;
struct {
int (*select)(ErlDrvPort, ErlDrvEvent, int, int);
+ int (*enif_select)(ErlNifEnv*, ErlNifEvent, enum ErlNifSelectFlags, void*, const ErlNifPid*, Eterm);
int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData);
void (*check_io_as_interrupt)(void);
void (*check_io_interrupt)(int);
@@ -174,6 +175,13 @@ driver_event(ErlDrvPort port, ErlDrvEvent event, ErlDrvEventData event_data)
return (*io_func.event)(port, event, event_data);
}
+int enif_select(ErlNifEnv* env, ErlNifEvent event,
+ enum ErlNifSelectFlags flags, void* obj, const ErlNifPid* pid, Eterm ref)
+{
+ return (*io_func.enif_select)(env, event, flags, obj, pid, ref);
+}
+
+
Eterm erts_check_io_info(void *p)
{
return (*io_func.info)(p);
@@ -191,6 +199,7 @@ init_check_io(void)
{
if (erts_use_kernel_poll) {
io_func.select = driver_select_kp;
+ io_func.enif_select = enif_select_kp;
io_func.event = driver_event_kp;
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_kp;
@@ -206,6 +215,7 @@ init_check_io(void)
}
else {
io_func.select = driver_select_nkp;
+ io_func.enif_select = enif_select_nkp;
io_func.event = driver_event_nkp;
#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT
io_func.check_io_as_interrupt = erts_check_io_async_sig_interrupt_nkp;
diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl
index 89e1aefb50..9258897764 100644
--- a/erts/emulator/test/erl_link_SUITE.erl
+++ b/erts/emulator/test/erl_link_SUITE.erl
@@ -60,7 +60,7 @@
% These are to be kept in sync with erl_monitors.h
-define(MON_ORIGIN, 1).
--define(MON_TARGET, 3).
+-define(MON_TARGET, 2).
-record(erl_link, {type = ?LINK_UNDEF,
@@ -69,7 +69,7 @@
% This is to be kept in sync with erl_bif_info.c (make_monitor_list)
--record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET (1 or 3)
+-record(erl_monitor, {type, % MON_ORIGIN or MON_TARGET
ref,
pid, % Process or nodename
name = []}). % registered name or []
diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl
index 8959be8690..693db42e58 100644
--- a/erts/emulator/test/nif_SUITE.erl
+++ b/erts/emulator/test/nif_SUITE.erl
@@ -31,6 +31,13 @@
init_per_testcase/2, end_per_testcase/2,
basic/1, reload_error/1, upgrade/1, heap_frag/1,
t_on_load/1,
+ select/1,
+ monitor_process_a/1,
+ monitor_process_b/1,
+ monitor_process_c/1,
+ monitor_process_d/1,
+ demonitor_process/1,
+ monitor_frenzy/1,
hipe/1,
types/1, many_args/1, binaries/1, get_string/1, get_atom/1,
maps/1,
@@ -56,6 +63,8 @@
-define(nif_stub,nif_stub_error(?LINE)).
+-define(is_resource, is_reference).
+
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
@@ -64,6 +73,9 @@ all() ->
[{group, G} || G <- api_groups()]
++
[reload_error, heap_frag, types, many_args,
+ select,
+ {group, monitor},
+ monitor_frenzy,
hipe,
binaries, get_string, get_atom, maps, api_macros, from_array,
iolist_as_binary, resource, resource_binary,
@@ -81,13 +93,19 @@ all() ->
nif_snprintf].
groups() ->
- [{G, [], api_repeaters()} || G <- api_groups()].
+ [{G, [], api_repeaters()} || G <- api_groups()]
+ ++
+ [{monitor, [], [monitor_process_a,
+ monitor_process_b,
+ monitor_process_c,
+ monitor_process_d,
+ demonitor_process]}].
+
api_groups() -> [api_latest, api_2_4, api_2_0].
api_repeaters() -> [upgrade, resource_takeover, t_on_load].
-init_per_group(api_latest, Config) -> Config;
init_per_group(api_2_4, Config) ->
[{nif_api_version, ".2_4"} | Config];
init_per_group(api_2_0, Config) ->
@@ -97,7 +115,8 @@ init_per_group(api_2_0, Config) ->
{skip, "API 2.0 buggy on Windows 64-bit"};
_ ->
[{nif_api_version, ".2_0"} | Config]
- end.
+ end;
+init_per_group(_, Config) -> Config.
end_per_group(_,_) -> ok.
@@ -109,6 +128,13 @@ init_per_testcase(hipe, Config) ->
undefined -> {skip, "HiPE is disabled"};
_ -> Config
end;
+init_per_testcase(select, Config) ->
+ case os:type() of
+ {win32,_} ->
+ {skip, "Test not yet implemented for windows"};
+ _ ->
+ Config
+ end;
init_per_testcase(_Case, Config) ->
Config.
@@ -434,6 +460,364 @@ t_on_load(Config) when is_list(Config) ->
verify_tmpmem(TmpMem),
ok.
+-define(ERL_NIF_SELECT_READ, (1 bsl 0)).
+-define(ERL_NIF_SELECT_WRITE, (1 bsl 1)).
+-define(ERL_NIF_SELECT_STOP, (1 bsl 2)).
+
+-define(ERL_NIF_SELECT_STOP_CALLED, (1 bsl 0)).
+-define(ERL_NIF_SELECT_STOP_SCHEDULED, (1 bsl 1)).
+-define(ERL_NIF_SELECT_INVALID_EVENT, (1 bsl 2)).
+-define(ERL_NIF_SELECT_FAILED, (1 bsl 3)).
+
+
+select(Config) when is_list(Config) ->
+ ensure_lib_loaded(Config),
+
+ Ref = make_ref(),
+ Ref2 = make_ref(),
+ {{R, R_ptr}, {W, W_ptr}} = pipe_nif(),
+ ok = write_nif(W, <<"hej">>),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Wait for read
+ eagain = read_nif(R, 3),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref),
+ [] = flush(),
+ ok = write_nif(W, <<"hej">>),
+ [{select, R, Ref, ready_input}] = flush(),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2),
+ [{select, R, Ref2, ready_input}] = flush(),
+ Papa = self(),
+ Pid = spawn_link(fun() ->
+ [{select, R, Ref, ready_input}] = flush(),
+ Papa ! {self(), done}
+ end),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,Pid,Ref),
+ {Pid, done} = receive_any(1000),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Wait for write
+ Written = write_full(W, $a),
+ 0 = select_nif(W,?ERL_NIF_SELECT_WRITE,W,self(),Ref),
+ [] = flush(),
+ Written = read_nif(R,byte_size(Written)),
+ [{select, W, Ref, ready_output}] = flush(),
+
+ %% Close write and wait for EOF
+ eagain = read_nif(R, 1),
+ check_stop_ret(select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref)),
+ [{fd_resource_stop, W_ptr, _}] = flush(),
+ {1, {W_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(W),
+ [] = flush(),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref),
+ [{select, R, Ref, ready_input}] = flush(),
+ eof = read_nif(R,1),
+
+ check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref)),
+ [{fd_resource_stop, R_ptr, _}] = flush(),
+ {1, {R_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(R),
+
+ select_2(Config).
+
+select_2(Config) ->
+ erlang:garbage_collect(),
+ {_,_,2} = last_resource_dtor_call(),
+
+ Ref1 = make_ref(),
+ Ref2 = make_ref(),
+ {{R, R_ptr}, {W, W_ptr}} = pipe_nif(),
+
+ %% Change ref
+ eagain = read_nif(R, 1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,self(),Ref2),
+
+ [] = flush(),
+ ok = write_nif(W, <<"hej">>),
+ [{select, R, Ref2, ready_input}] = flush(),
+ <<"hej">> = read_nif(R, 3),
+
+ %% Change pid
+ eagain = read_nif(R, 1),
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ Papa = self(),
+ spawn_link(fun() ->
+ 0 = select_nif(R,?ERL_NIF_SELECT_READ,R,null,Ref1),
+ [] = flush(),
+ Papa ! sync,
+ [{select, R, Ref1, ready_input}] = flush(),
+ <<"hej">> = read_nif(R, 3),
+ Papa ! done
+ end),
+ sync = receive_any(),
+ ok = write_nif(W, <<"hej">>),
+ done = receive_any(),
+ [] = flush(),
+
+ check_stop_ret(select_nif(R,?ERL_NIF_SELECT_STOP,R,null,Ref1)),
+ [{fd_resource_stop, R_ptr, _}] = flush(),
+ {1, {R_ptr,_}} = last_fd_stop_call(),
+ true = is_closed_nif(R),
+
+ %% Stop without previous read/write select
+ ?ERL_NIF_SELECT_STOP_CALLED = select_nif(W,?ERL_NIF_SELECT_STOP,W,null,Ref1),
+ [{fd_resource_stop, W_ptr, 1}] = flush(),
+ {1, {W_ptr,1}} = last_fd_stop_call(),
+ true = is_closed_nif(W),
+
+ select_3(Config).
+
+select_3(_Config) ->
+ erlang:garbage_collect(),
+ {_,_,2} = last_resource_dtor_call(),
+ ok.
+
+check_stop_ret(?ERL_NIF_SELECT_STOP_CALLED) -> ok;
+check_stop_ret(?ERL_NIF_SELECT_STOP_SCHEDULED) -> ok.
+
+write_full(W, C) ->
+ write_full(W, C, <<>>).
+write_full(W, C, Acc) ->
+ case write_nif(W, <<C>>) of
+ ok ->
+ write_full(W, (C+1) band 255, <<Acc/binary, C>>);
+ {eagain,0} ->
+ Acc
+ end.
+
+%% Basic monitoring of one process that terminates
+monitor_process_a(Config) ->
+ ensure_lib_loaded(Config),
+
+ F = fun(Terminator, UseMsgEnv) ->
+ Pid = spawn(fun() ->
+ receive
+ {exit, Arg} -> exit(Arg);
+ return -> ok;
+ BadMatch -> goodmatch = BadMatch
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0, Mon1} = monitor_process_nif(R_ptr, Pid, UseMsgEnv, self()),
+ [R_ptr] = monitored_by(Pid),
+ Terminator(Pid),
+ [{monitor_resource_down, R_ptr, Pid, Mon2}] = flush(),
+ 0 = compare_monitors_nif(Mon1, Mon2),
+ [] = last_resource_dtor_call(),
+ ok = release_resource(R_ptr),
+ {R_ptr, _, 1} = last_resource_dtor_call()
+ end,
+
+ T1 = fun(Pid) -> Pid ! {exit, 17} end,
+ T2 = fun(Pid) -> Pid ! return end,
+ T3 = fun(Pid) -> Pid ! badmatch end,
+ T4 = fun(Pid) -> exit(Pid, 18) end,
+
+ [F(T, UME) || T <- [T1,T2,T3,T4], UME <- [true, false]],
+
+ ok.
+
+%% Test auto-demonitoring at resource destruction
+monitor_process_b(Config) ->
+ ensure_lib_loaded(Config),
+
+ Pid = spawn_link(fun() ->
+ receive
+ return -> ok
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,_} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr] = monitored_by(Pid),
+ ok = release_resource(R_ptr),
+ [] = flush(),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ [] = monitored_by(Pid),
+ Pid ! return,
+ ok.
+
+%% Test termination of monitored process holding last resource ref
+monitor_process_c(Config) ->
+ ensure_lib_loaded(Config),
+
+ Papa = self(),
+ Pid = spawn_link(fun() ->
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,Mon} = monitor_process_nif(R_ptr, self(), true, Papa),
+ [R_ptr] = monitored_by(self()),
+ put(store, make_resource(R_ptr)),
+ ok = release_resource(R_ptr),
+ [] = last_resource_dtor_call(),
+ Papa ! {self(), done, R_ptr, Mon},
+ exit
+ end),
+ [{Pid, done, R_ptr, Mon1},
+ {monitor_resource_down, R_ptr, Pid, Mon2}] = flush(),
+ compare_monitors_nif(Mon1, Mon2),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ ok.
+
+%% Test race of resource dtor called when monitored process is exiting
+monitor_process_d(Config) ->
+ ensure_lib_loaded(Config),
+
+ Papa = self(),
+ {Target,TRef} = spawn_monitor(fun() ->
+ nothing = receive_any()
+ end),
+
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,_} = monitor_process_nif(R_ptr, Target, true, self()),
+ [Papa, R_ptr] = monitored_by(Target),
+
+ exit(Target, die),
+ ok = release_resource(R_ptr),
+
+ [{'DOWN', TRef, process, Target, die}] = flush(), %% no monitor_resource_down
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+
+ ok.
+
+%% Test basic demonitoring
+demonitor_process(Config) ->
+ ensure_lib_loaded(Config),
+
+ Pid = spawn_link(fun() ->
+ receive
+ return -> ok
+ end
+ end),
+ R_ptr = alloc_monitor_resource_nif(),
+ {0,MonBin1} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr] = monitored_by(Pid),
+ {0,MonBin2} = monitor_process_nif(R_ptr, Pid, true, self()),
+ [R_ptr, R_ptr] = monitored_by(Pid),
+ 0 = demonitor_process_nif(R_ptr, MonBin1),
+ [R_ptr] = monitored_by(Pid),
+ 1 = demonitor_process_nif(R_ptr, MonBin1),
+ 0 = demonitor_process_nif(R_ptr, MonBin2),
+ [] = monitored_by(Pid),
+ 1 = demonitor_process_nif(R_ptr, MonBin2),
+
+ ok = release_resource(R_ptr),
+ [] = flush(),
+ {R_ptr, _, 1} = last_resource_dtor_call(),
+ [] = monitored_by(Pid),
+ Pid ! return,
+ ok.
+
+
+monitored_by(Pid) ->
+ {monitored_by, List0} = process_info(Pid, monitored_by),
+ List1 = lists:map(fun(E) when ?is_resource(E) ->
+ {Ptr, _} = get_resource(monitor_resource_type, E),
+ Ptr;
+ (E) -> E
+ end,
+ List0),
+ erlang:garbage_collect(),
+ lists:sort(List1).
+
+-define(FRENZY_RAND_BITS, 25).
+
+%% Exercise monitoring from NIF resources by randomly
+%% create/destruct processes, resources and monitors.
+monitor_frenzy(Config) ->
+ ensure_lib_loaded(Config),
+
+ Procs1 = processes(),
+ io:format("~p processes before: ~p\n", [length(Procs1), Procs1]),
+
+ %% Spawn first worker process
+ Master = self(),
+ spawn_link(fun() ->
+ SelfPix = monitor_frenzy_nif(init, ?FRENZY_RAND_BITS, 0, 0),
+ unlink(Master),
+ frenzy(SelfPix, {undefined, []})
+ end),
+ receive after 5*1000 -> ok end,
+
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ Pids = monitor_frenzy_nif(stop, 0, 0, 0),
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ lists:foreach(fun(P) ->
+ MRef = monitor(process, P),
+ exit(P, stop),
+ {'DOWN', MRef, process, P, _} = receive_any()
+ end,
+ Pids),
+
+ io:format("stats = ~p\n", [monitor_frenzy_nif(stats, 0, 0, 0)]),
+
+ Procs2 = processes(),
+ io:format("~p processes after: ~p\n", [length(Procs2), Procs2]),
+ ok.
+
+
+frenzy(_SelfPix, done) ->
+ ok;
+frenzy(SelfPix, State0) ->
+ Rnd = rand:uniform(1 bsl (?FRENZY_RAND_BITS+2)) - 1,
+ Op = Rnd band 3,
+ State1 = frenzy_do_op(SelfPix, Op, (Rnd bsr 2), State0),
+ frenzy(SelfPix, State1).
+
+frenzy_do_op(SelfPix, Op, Rnd, {Pid0,RBins}=State0) ->
+ case Op of
+ 0 -> % add/remove process
+ Papa = self(),
+ NewPid = case Pid0 of
+ undefined -> % Prepare new process to be added
+ spawn(fun() ->
+ MRef = monitor(process, Papa),
+ case receive_any() of
+ {go, MyPix, MyState} ->
+ demonitor(MRef, [flush]),
+ frenzy(MyPix, MyState);
+ {'DOWN', MRef, process, Papa, _} ->
+ ok
+ end
+ end);
+ _ ->
+ Pid0
+ end,
+ case monitor_frenzy_nif(Op, Rnd, SelfPix, NewPid) of
+ NewPix when is_integer(NewPix) ->
+ NewPid ! {go, NewPix, {undefined, []}},
+ {undefined, RBins};
+ ExitPid when is_pid(ExitPid) ->
+ false = (ExitPid =:= self()),
+ exit(ExitPid,die),
+ {NewPid, RBins};
+ done ->
+ done
+ end;
+
+ 3 ->
+ %% Try provoke revival-race of resource from magic ref external format
+ _ = [binary_to_term(B) || B <- RBins],
+ {Pid0, []};
+ _ ->
+ case monitor_frenzy_nif(Op, Rnd, SelfPix, undefined) of
+ Rsrc when ?is_resource(Rsrc) ->
+ %% Store resource in ext format only, for later revival
+ State1 = {Pid0, [term_to_binary(Rsrc) | RBins]},
+ gc_and_return(State1);
+ ok -> State0;
+ 0 -> State0;
+ 1 -> State0;
+ done -> done
+ end
+ end.
+
+gc_and_return(RetVal) ->
+ erlang:garbage_collect(),
+ RetVal.
+
hipe(Config) when is_list(Config) ->
Data = proplists:get_value(data_dir, Config),
Priv = proplists:get_value(priv_dir, Config),
@@ -689,6 +1073,7 @@ maps(Config) when is_list(Config) ->
{1, M2} = make_map_remove_nif(M2, "key3"),
{0, undefined} = make_map_remove_nif(self(), key),
+ verify_tmpmem(TmpMem),
ok.
%% Test macros enif_make_list<N> and enif_make_tuple<N>
@@ -807,7 +1192,7 @@ resource_new_do2(Type) ->
ResB = make_new_resource(Type, BinB),
true = is_reference(ResA),
true = is_reference(ResB),
- ResA /= ResB,
+ true = (ResA /= ResB),
{PtrA,BinA} = get_resource(Type, ResA),
{PtrB,BinB} = get_resource(Type, ResB),
true = (PtrA =/= PtrB),
@@ -1178,7 +1563,7 @@ resource_takeover(Config) when is_list(Config) ->
[{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(),
{NA7,BinNA7} = make_resource(0, Holder, "NA7"),
- {AN7,BinAN7} = make_resource(1, Holder, "AN7"),
+ {AN7,_BinAN7} = make_resource(1, Holder, "AN7"),
ok = forget_resource(NA7),
[{{resource_dtor_A_v1,BinNA7},1,_,_}] = nif_mod_call_history(),
@@ -1669,7 +2054,7 @@ otp_9828(Config) ->
ensure_lib_loaded(Config, 1),
otp_9828_loop(<<"I'm alive!">>, 1000).
-otp_9828_loop(Bin, 0) ->
+otp_9828_loop(_Bin, 0) ->
ok;
otp_9828_loop(Bin, Val) ->
WrtBin = <<Bin/binary, Val:32>>,
@@ -1911,6 +2296,19 @@ call(Pid,Cmd) ->
receive_any() ->
receive M -> M end.
+receive_any(Timeout) ->
+ receive M -> M
+ after Timeout -> timeout end.
+
+flush() ->
+ flush(10).
+flush(Timeout) ->
+ receive M ->
+ [M | flush(Timeout)]
+ after Timeout ->
+ []
+ end.
+
repeat(0, _, Arg) ->
Arg;
repeat(N, Fun, Arg0) ->
@@ -1942,7 +2340,7 @@ nif_raise_exceptions(NifFunc) ->
-define(ERL_NIF_TIME_ERROR, -9223372036854775808).
-define(TIME_UNITS, [second, millisecond, microsecond, nanosecond]).
-nif_monotonic_time(Config) ->
+nif_monotonic_time(_Config) ->
?ERL_NIF_TIME_ERROR = monotonic_time(invalid_time_unit),
mtime_loop(1000000).
@@ -1967,7 +2365,7 @@ chk_mtime([TU|TUs]) ->
end,
chk_mtime(TUs).
-nif_time_offset(Config) ->
+nif_time_offset(_Config) ->
?ERL_NIF_TIME_ERROR = time_offset(invalid_time_unit),
toffs_loop(1000000).
@@ -2005,7 +2403,7 @@ chk_toffs([TU|TUs]) ->
end,
chk_toffs(TUs).
-nif_convert_time_unit(Config) ->
+nif_convert_time_unit(_Config) ->
?ERL_NIF_TIME_ERROR = convert_time_unit(0, second, invalid_time_unit),
?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, second),
?ERL_NIF_TIME_ERROR = convert_time_unit(0, invalid_time_unit, invalid_time_unit),
@@ -2274,6 +2672,17 @@ term_to_binary_nif(_, _) -> ?nif_stub.
binary_to_term_nif(_, _, _) -> ?nif_stub.
port_command_nif(_, _) -> ?nif_stub.
format_term_nif(_,_) -> ?nif_stub.
+select_nif(_,_,_,_,_) -> ?nif_stub.
+pipe_nif() -> ?nif_stub.
+write_nif(_,_) -> ?nif_stub.
+read_nif(_,_) -> ?nif_stub.
+is_closed_nif(_) -> ?nif_stub.
+last_fd_stop_call() -> ?nif_stub.
+alloc_monitor_resource_nif() -> ?nif_stub.
+monitor_process_nif(_,_,_,_) -> ?nif_stub.
+demonitor_process_nif(_,_) -> ?nif_stub.
+compare_monitors_nif(_,_) -> ?nif_stub.
+monitor_frenzy_nif(_,_,_,_) -> ?nif_stub.
%% maps
is_map_nif(_) -> ?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 7331c5b2cd..8fe5ee809a 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c
@@ -23,12 +23,35 @@
#include <string.h>
#include <assert.h>
#include <limits.h>
+#include <errno.h>
#ifndef __WIN32__
#include <unistd.h>
+#include <fcntl.h>
#endif
#include "nif_mod.h"
+#if 0
+static ErlNifMutex* dbg_trace_lock;
+#define DBG_TRACE_INIT dbg_trace_lock = enif_mutex_create("nif_SUITE.DBG_TRACE")
+#define DBG_TRACE_FINI enif_mutex_destroy(dbg_trace_lock)
+#define DBG_TRACE_LOCK enif_mutex_lock(dbg_trace_lock)
+#define DBG_TRACE_UNLOCK enif_mutex_unlock(dbg_trace_lock)
+#define DBG_TRACE0(FMT) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE1(FMT, A) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE2(FMT, A, B) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE3(FMT, A, B, C) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C); DBG_TRACE_UNLOCK; }while(0)
+#define DBG_TRACE4(FMT, A, B, C, D) do {DBG_TRACE_LOCK; enif_fprintf(stderr, FMT, A, B, C, D); DBG_TRACE_UNLOCK; }while(0)
+#else
+#define DBG_TRACE_INIT
+#define DBG_TRACE_FINI
+#define DBG_TRACE0(FMT)
+#define DBG_TRACE1(FMT, A)
+#define DBG_TRACE2(FMT, A, B)
+#define DBG_TRACE3(FMT, A, B, C)
+#define DBG_TRACE4(FMT, A, B, C, D)
+#endif
+
static int static_cntA; /* zero by default */
static int static_cntB = NIF_SUITE_LIB_VER * 100;
@@ -42,7 +65,17 @@ static ERL_NIF_TERM atom_second;
static ERL_NIF_TERM atom_millisecond;
static ERL_NIF_TERM atom_microsecond;
static ERL_NIF_TERM atom_nanosecond;
-
+static ERL_NIF_TERM atom_eagain;
+static ERL_NIF_TERM atom_eof;
+static ERL_NIF_TERM atom_error;
+static ERL_NIF_TERM atom_fd_resource_stop;
+static ERL_NIF_TERM atom_monitor_resource_type;
+static ERL_NIF_TERM atom_monitor_resource_down;
+static ERL_NIF_TERM atom_init;
+static ERL_NIF_TERM atom_stats;
+static ERL_NIF_TERM atom_done;
+static ERL_NIF_TERM atom_stop;
+static ERL_NIF_TERM atom_null;
typedef struct
{
@@ -102,6 +135,41 @@ struct binary_resource {
unsigned size;
};
+static ErlNifResourceType* fd_resource_type;
+static void fd_resource_dtor(ErlNifEnv* env, void* obj);
+static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent, int);
+static ErlNifResourceTypeInit fd_rt_init = {
+ fd_resource_dtor,
+ fd_resource_stop
+};
+struct fd_resource {
+ ErlNifEvent fd;
+ int was_selected;
+ ErlNifPid pid;
+};
+
+static ErlNifResourceType* monitor_resource_type;
+static void monitor_resource_dtor(ErlNifEnv* env, void* obj);
+static void monitor_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*);
+static ErlNifResourceTypeInit monitor_rt_init = {
+ monitor_resource_dtor,
+ NULL,
+ monitor_resource_down
+};
+struct monitor_resource {
+ ErlNifPid receiver;
+ int use_msgenv;
+};
+
+static ErlNifResourceType* frenzy_resource_type;
+static void frenzy_resource_dtor(ErlNifEnv* env, void* obj);
+static void frenzy_resource_down(ErlNifEnv*, void* obj, ErlNifPid*, ErlNifMonitor*);
+static ErlNifResourceTypeInit frenzy_rt_init = {
+ frenzy_resource_dtor,
+ NULL,
+ frenzy_resource_down
+};
+
static int get_pointer(ErlNifEnv* env, ERL_NIF_TERM term, void** pp)
{
ErlNifBinary bin;
@@ -129,6 +197,8 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
data->call_history = NULL;
data->nif_mod = NULL;
+ DBG_TRACE_INIT;
+
add_call(env, data, "load");
data->rt_arr[0].t = enif_open_resource_type(env,NULL,"Gold",resource_dtor,
@@ -143,6 +213,16 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
msgenv_resource_type = enif_open_resource_type(env,NULL,"nif_SUITE.msgenv",
msgenv_dtor,
ERL_NIF_RT_CREATE, NULL);
+ fd_resource_type = enif_open_resource_type_x(env, "nif_SUITE.fd",
+ &fd_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+ monitor_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor",
+ &monitor_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+ frenzy_resource_type = enif_open_resource_type_x(env, "nif_SUITE.monitor_frenzy",
+ &frenzy_rt_init,
+ ERL_NIF_RT_CREATE, NULL);
+
atom_false = enif_make_atom(env,"false");
atom_true = enif_make_atom(env,"true");
atom_self = enif_make_atom(env,"self");
@@ -153,6 +233,17 @@ static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info)
atom_millisecond = enif_make_atom(env,"millisecond");
atom_microsecond = enif_make_atom(env,"microsecond");
atom_nanosecond = enif_make_atom(env,"nanosecond");
+ atom_eagain = enif_make_atom(env, "eagain");
+ atom_eof = enif_make_atom(env, "eof");
+ atom_error = enif_make_atom(env, "error");
+ atom_fd_resource_stop = enif_make_atom(env, "fd_resource_stop");
+ atom_monitor_resource_type = enif_make_atom(env, "monitor_resource_type");
+ atom_monitor_resource_down = enif_make_atom(env, "monitor_resource_down");
+ atom_init = enif_make_atom(env,"init");
+ atom_stats = enif_make_atom(env,"stats");
+ atom_done = enif_make_atom(env,"done");
+ atom_stop = enif_make_atom(env,"stop");
+ atom_null = enif_make_atom(env,"null");
*priv_data = data;
return 0;
@@ -206,6 +297,7 @@ static void unload(ErlNifEnv* env, void* priv_data)
}
enif_free(priv_data);
}
+ DBG_TRACE_FINI;
}
static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -829,6 +921,9 @@ static ERL_NIF_TERM get_resource(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar
if (enif_is_identical(argv[0], atom_binary_resource_type)) {
type.t = binary_resource_type;
}
+ else if (enif_is_identical(argv[0], atom_monitor_resource_type)) {
+ type.t = monitor_resource_type;
+ }
else {
get_pointer(env, argv[0], &type.vp);
}
@@ -1107,10 +1202,6 @@ static ERL_NIF_TERM make_term_string(struct make_term_info* mti, int n)
{
return enif_make_string(mti->dst_env, "Hello!", ERL_NIF_LATIN1);
}
-static ERL_NIF_TERM make_term_ref(struct make_term_info* mti, int n)
-{
- return enif_make_ref(mti->dst_env);
-}
static ERL_NIF_TERM make_term_sub_binary(struct make_term_info* mti, int n)
{
ERL_NIF_TERM orig;
@@ -1213,7 +1304,6 @@ static Make_term_Func* make_funcs[] = {
make_term_atom,
make_term_existing_atom,
make_term_string,
- //make_term_ref,
make_term_sub_binary,
make_term_uint,
make_term_long,
@@ -1493,7 +1583,6 @@ static ERL_NIF_TERM send_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[
static ERL_NIF_TERM send_copy_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
- ErlNifEnv* menv;
ErlNifPid pid;
int ret;
if (!enif_get_local_pid(env, argv[0], &pid)) {
@@ -2037,6 +2126,733 @@ static ERL_NIF_TERM format_term(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
}
+static int get_fd(ErlNifEnv* env, ERL_NIF_TERM term, struct fd_resource** rsrc)
+{
+ if (!enif_get_resource(env, term, fd_resource_type, (void**)rsrc)) {
+ return 0;
+ }
+ return 1;
+}
+
+static ERL_NIF_TERM select_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ enum ErlNifSelectFlags mode;
+ void* obj;
+ ErlNifPid nifpid, *pid = NULL;
+ ERL_NIF_TERM ref;
+ int retval;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_get_uint(env, argv[1], (unsigned int*)&mode)
+ || !enif_get_resource(env, argv[2], fd_resource_type, &obj))
+ {
+ return enif_make_badarg(env);
+ }
+
+ if (argv[3] != atom_null) {
+ if (!enif_get_local_pid(env, argv[3], &nifpid))
+ return enif_make_badarg(env);
+ pid = &nifpid;
+ }
+ ref = argv[4];
+
+ fdr->was_selected = 1;
+ enif_self(env, &fdr->pid);
+ retval = enif_select(env, fdr->fd, mode, obj, pid, ref);
+
+ return enif_make_int(env, retval);
+}
+
+#ifndef __WIN32__
+static ERL_NIF_TERM pipe_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* read_rsrc;
+ struct fd_resource* write_rsrc;
+ ERL_NIF_TERM read_fd, write_fd;
+ int fds[2], flags;
+
+ if (pipe(fds) < 0)
+ return enif_make_string(env, "pipe failed", ERL_NIF_LATIN1);
+
+ if ((flags = fcntl(fds[0], F_GETFL, 0)) < 0
+ || fcntl(fds[0], F_SETFL, flags|O_NONBLOCK) < 0
+ || (flags = fcntl(fds[1], F_GETFL, 0)) < 0
+ || fcntl(fds[1], F_SETFL, flags|O_NONBLOCK) < 0) {
+ close(fds[0]);
+ close(fds[1]);
+ return enif_make_string(env, "fcntl failed on pipe", ERL_NIF_LATIN1);
+ }
+
+ read_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource));
+ write_rsrc = enif_alloc_resource(fd_resource_type, sizeof(struct fd_resource));
+ read_rsrc->fd = fds[0];
+ read_rsrc->was_selected = 0;
+ write_rsrc->fd = fds[1];
+ write_rsrc->was_selected = 0;
+ read_fd = enif_make_resource(env, read_rsrc);
+ write_fd = enif_make_resource(env, write_rsrc);
+ enif_release_resource(read_rsrc);
+ enif_release_resource(write_rsrc);
+
+ return enif_make_tuple2(env,
+ enif_make_tuple2(env, read_fd, make_pointer(env, read_rsrc)),
+ enif_make_tuple2(env, write_fd, make_pointer(env, write_rsrc)));
+}
+
+static ERL_NIF_TERM write_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ ErlNifBinary bin;
+ int n, written = 0;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_inspect_binary(env, argv[1], &bin))
+ return enif_make_badarg(env);
+
+ for (;;) {
+ n = write(fdr->fd, bin.data + written, bin.size - written);
+ if (n >= 0) {
+ written += n;
+ if (written == bin.size) {
+ return atom_ok;
+ }
+ }
+ else if (errno == EAGAIN) {
+ return enif_make_tuple2(env, atom_eagain, enif_make_int(env, written));
+ }
+ else if (errno == EINTR) {
+ continue;
+ }
+ else {
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, errno));
+ }
+ }
+}
+
+static ERL_NIF_TERM read_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+ unsigned char* buf;
+ int n, count;
+ ERL_NIF_TERM res;
+
+ if (!get_fd(env, argv[0], &fdr)
+ || !enif_get_int(env, argv[1], &count) || count < 1)
+ return enif_make_badarg(env);
+
+ buf = enif_make_new_binary(env, count, &res);
+
+ for (;;) {
+ n = read(fdr->fd, buf, count);
+ if (n > 0) {
+ if (n < count) {
+ res = enif_make_sub_binary(env, res, 0, n);
+ }
+ return res;
+ }
+ else if (n == 0) {
+ return atom_eof;
+ }
+ else if (errno == EAGAIN) {
+ return atom_eagain;
+ }
+ else if (errno == EINTR) {
+ continue;
+ }
+ else {
+ return enif_make_tuple2(env, atom_error, enif_make_int(env, errno));
+ }
+ }
+}
+
+static ERL_NIF_TERM is_closed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct fd_resource* fdr;
+
+ if (!get_fd(env, argv[0], &fdr))
+ return enif_make_badarg(env);
+
+ return fdr->fd < 0 ? atom_true : atom_false;
+}
+#endif /* !__WIN32__ */
+
+
+static void fd_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ struct fd_resource* fdr = (struct fd_resource*)obj;
+ resource_dtor(env, obj);
+#ifdef __WIN32__
+ abort();
+#else
+ if (fdr->fd >= 0) {
+ assert(!fdr->was_selected);
+ close(fdr->fd);
+ }
+#endif
+}
+
+static struct {
+ void* obj;
+ int was_direct_call;
+}last_fd_stop;
+int fd_stop_cnt = 0;
+
+static void fd_resource_stop(ErlNifEnv* env, void* obj, ErlNifEvent fd,
+ int is_direct_call)
+{
+ struct fd_resource* fdr = (struct fd_resource*)obj;
+ assert(fd == fdr->fd);
+ assert(fd >= 0);
+
+ last_fd_stop.obj = obj;
+ last_fd_stop.was_direct_call = is_direct_call;
+ fd_stop_cnt++;
+
+ close(fd);
+ fdr->fd = -1; /* thread safety ? */
+ fdr->was_selected = 0;
+
+ {
+ ErlNifEnv* msg_env = enif_alloc_env();
+ ERL_NIF_TERM msg;
+ msg = enif_make_tuple3(msg_env,
+ atom_fd_resource_stop,
+ make_pointer(msg_env, obj),
+ enif_make_int(msg_env, is_direct_call));
+
+ enif_send(env, &fdr->pid, msg_env, msg);
+ enif_free_env(msg_env);
+ }
+}
+
+static ERL_NIF_TERM last_fd_stop_call(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ERL_NIF_TERM last, ret;
+ last = enif_make_tuple2(env, make_pointer(env, last_fd_stop.obj),
+ enif_make_int(env, last_fd_stop.was_direct_call));
+ ret = enif_make_tuple2(env, enif_make_int(env, fd_stop_cnt), last);
+ fd_stop_cnt = 0;
+ return ret;
+}
+
+
+static void monitor_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ resource_dtor(env, obj);
+}
+
+static ERL_NIF_TERM make_monitor(ErlNifEnv* env, const ErlNifMonitor* mon)
+{
+ ERL_NIF_TERM mon_bin;
+ memcpy(enif_make_new_binary(env, sizeof(ErlNifMonitor), &mon_bin),
+ mon, sizeof(ErlNifMonitor));
+ return mon_bin;
+}
+
+static int get_monitor(ErlNifEnv* env, ERL_NIF_TERM term, ErlNifMonitor* mon)
+{
+ ErlNifBinary bin;
+ if (!enif_inspect_binary(env, term, &bin)
+ || bin.size != sizeof(ErlNifMonitor))
+ return 0;
+ memcpy(mon, bin.data, bin.size);
+ return 1;
+}
+
+static void monitor_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid,
+ ErlNifMonitor* mon)
+{
+ struct monitor_resource* rsrc = (struct monitor_resource*)obj;
+ ErlNifEnv* build_env;
+ ErlNifEnv* msg_env;
+ ERL_NIF_TERM msg;
+
+ if (rsrc->use_msgenv) {
+ msg_env = enif_alloc_env();
+ build_env = msg_env;
+ }
+ else {
+ msg_env = NULL;
+ build_env = env;
+ }
+
+ msg = enif_make_tuple4(build_env,
+ atom_monitor_resource_down,
+ make_pointer(build_env, obj),
+ enif_make_pid(build_env, pid),
+ make_monitor(build_env, mon));
+
+ enif_send(env, &rsrc->receiver, msg_env, msg);
+ if (msg_env)
+ enif_free_env(msg_env);
+}
+
+static ERL_NIF_TERM alloc_monitor_resource_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+
+ rsrc = enif_alloc_resource(monitor_resource_type, sizeof(struct monitor_resource));
+
+ return make_pointer(env,rsrc);
+}
+
+static ERL_NIF_TERM monitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+ ErlNifPid target;
+ ErlNifMonitor mon;
+ int res;
+
+ if (!get_pointer(env, argv[0], (void**)&rsrc)
+ || !enif_get_local_pid(env, argv[1], &target)
+ || !enif_get_local_pid(env, argv[3], &rsrc->receiver)) {
+ return enif_make_badarg(env);
+ }
+
+ rsrc->use_msgenv = (argv[2] == atom_true);
+ res = enif_monitor_process(env, rsrc, &target, &mon);
+
+ return enif_make_tuple2(env, enif_make_int(env, res), make_monitor(env, &mon));
+}
+
+static ERL_NIF_TERM demonitor_process_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct monitor_resource* rsrc;
+ ErlNifMonitor mon;
+ int res;
+
+ if (!get_pointer(env, argv[0], (void**)&rsrc)
+ || !get_monitor(env, argv[1], &mon)) {
+ return enif_make_badarg(env);
+ }
+
+ res = enif_demonitor_process(env, rsrc, &mon);
+
+ return enif_make_int(env, res);
+}
+
+static ERL_NIF_TERM compare_monitors_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ ErlNifMonitor m1, m2;
+ if (!get_monitor(env, argv[0], &m1)
+ || !get_monitor(env, argv[1], &m2)) {
+ return enif_make_badarg(env);
+ }
+
+ return enif_make_int(env, enif_compare_monitors(&m1, &m2));
+}
+
+
+/*********** monitor_frenzy ************/
+
+struct frenzy_rand_bits
+{
+ unsigned int source;
+ unsigned int bits_consumed;
+};
+
+static unsigned int frenzy_rand_bits_max;
+
+unsigned rand_bits(struct frenzy_rand_bits* rnd, unsigned int nbits)
+{
+ unsigned int res;
+
+ rnd->bits_consumed += nbits;
+ assert(rnd->bits_consumed <= frenzy_rand_bits_max);
+ res = rnd->source & ((1 << nbits)-1);
+ rnd->source >>= nbits;
+ return res;
+}
+
+#define FRENZY_PROCS_MAX_BITS 4
+#define FRENZY_PROCS_MAX (1 << FRENZY_PROCS_MAX_BITS)
+
+#define FRENZY_RESOURCES_MAX_BITS 4
+#define FRENZY_RESOURCES_MAX (1 << FRENZY_RESOURCES_MAX_BITS)
+
+#define FRENZY_MONITORS_MAX_BITS 4
+#define FRENZY_MONITORS_MAX (1 << FRENZY_MONITORS_MAX_BITS)
+
+struct frenzy_monitor {
+ ErlNifMutex* lock;
+ enum {
+ MON_FREE, MON_FREE_DOWN, MON_FREE_DEMONITOR,
+ MON_TRYING, MON_ACTIVE, MON_PENDING
+ } state;
+ ErlNifMonitor mon;
+ ErlNifPid pid;
+ unsigned int use_cnt;
+};
+
+struct frenzy_resource {
+ unsigned int rix;
+ struct frenzy_monitor monv[FRENZY_MONITORS_MAX];
+};
+struct frenzy_reslot {
+ ErlNifMutex* lock;
+ int stopped;
+ struct frenzy_resource* obj;
+ unsigned long alloc_cnt;
+ unsigned long release_cnt;
+ unsigned long dtor_cnt;
+};
+static struct frenzy_reslot resv[FRENZY_RESOURCES_MAX];
+
+static ERL_NIF_TERM monitor_frenzy_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{
+ struct frenzy_proc {
+ ErlNifPid pid;
+ int is_free;
+ };
+ static struct frenzy_proc procs[FRENZY_PROCS_MAX];
+ static struct frenzy_proc* proc_refs[FRENZY_PROCS_MAX];
+ static unsigned int nprocs, old_nprocs;
+ static ErlNifMutex* procs_lock;
+ static unsigned long spawn_cnt = 0;
+ static unsigned long kill_cnt = 0;
+ static unsigned long proc_histogram[FRENZY_PROCS_MAX];
+
+ static const unsigned int primes[] = {7, 13, 17, 19};
+
+ struct frenzy_resource* r;
+ struct frenzy_rand_bits rnd;
+ unsigned int op, inc, my_nprocs;
+ unsigned int mix; /* r->monv[] index */
+ unsigned int rix; /* resv[] index */
+ unsigned int pix; /* procs[] index */
+ unsigned int ref_ix; /* proc_refs[] index */
+ int self_pix, rv;
+ ERL_NIF_TERM retval = atom_error;
+ const ERL_NIF_TERM Op = argv[0];
+ const ERL_NIF_TERM Rnd = argv[1];
+ const ERL_NIF_TERM SelfPix = argv[2];
+ const ERL_NIF_TERM NewPid = argv[3];
+
+ if (enif_is_atom(env, Op)) {
+ if (Op == atom_init) {
+ if (procs_lock || !enif_get_uint(env, Rnd, &frenzy_rand_bits_max))
+ return enif_make_badarg(env);
+
+ procs_lock = enif_mutex_create("nif_SUITE:monitor_frenzy.procs");
+ nprocs = 0;
+ old_nprocs = 0;
+ for (pix = 0; pix < FRENZY_PROCS_MAX; pix++) {
+ proc_refs[pix] = &procs[pix];
+ procs[pix].is_free = 1;
+ proc_histogram[pix] = 0;
+ }
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ resv[rix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.resv.lock");
+ resv[rix].obj = NULL;
+ resv[rix].stopped = 0;
+ resv[rix].alloc_cnt = 0;
+ resv[rix].release_cnt = 0;
+ resv[rix].dtor_cnt = 0;
+ }
+
+ /* Add self as first process */
+ enif_self(env, &procs[0].pid);
+ procs[0].is_free = 0;
+ old_nprocs = ++nprocs;
+
+ spawn_cnt = 1;
+ kill_cnt = 0;
+ return enif_make_uint(env, 0); /* SelfPix */
+ }
+ else if (Op == atom_stats) {
+ ERL_NIF_TERM hist[FRENZY_PROCS_MAX];
+ unsigned long res_alloc_cnt = 0;
+ unsigned long res_release_cnt = 0;
+ unsigned long res_dtor_cnt = 0;
+ for (ref_ix = 0; ref_ix < FRENZY_PROCS_MAX; ref_ix++) {
+ hist[ref_ix] = enif_make_ulong(env, proc_histogram[ref_ix]);
+ }
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ res_alloc_cnt += resv[rix].alloc_cnt;
+ res_release_cnt += resv[rix].release_cnt;
+ res_dtor_cnt += resv[rix].dtor_cnt;
+ }
+
+ return
+ enif_make_list4(env,
+ enif_make_tuple2(env, enif_make_string(env, "proc_histogram", ERL_NIF_LATIN1),
+ enif_make_list_from_array(env, hist, FRENZY_PROCS_MAX)),
+ enif_make_tuple2(env, enif_make_string(env, "spawn_cnt", ERL_NIF_LATIN1),
+ enif_make_ulong(env, spawn_cnt)),
+ enif_make_tuple2(env, enif_make_string(env, "kill_cnt", ERL_NIF_LATIN1),
+ enif_make_ulong(env, kill_cnt)),
+ enif_make_tuple4(env, enif_make_string(env, "resource_alloc", ERL_NIF_LATIN1),
+ enif_make_ulong(env, res_alloc_cnt),
+ enif_make_ulong(env, res_release_cnt),
+ enif_make_ulong(env, res_dtor_cnt)));
+
+ }
+ else if (Op == atom_stop && procs_lock) { /* stop all */
+
+ /* Release all resources */
+ for (rix = 0; rix < FRENZY_RESOURCES_MAX; rix++) {
+ enif_mutex_lock(resv[rix].lock);
+ r = resv[rix].obj;
+ if (r) {
+ resv[rix].obj = NULL;
+ resv[rix].release_cnt++;
+ }
+ resv[rix].stopped = 1;
+ enif_mutex_unlock(resv[rix].lock);
+ if (r)
+ enif_release_resource(r);
+ }
+
+ /* Remove and return all pids */
+ retval = enif_make_list(env, 0);
+ enif_mutex_lock(procs_lock);
+ for (ref_ix = 0; ref_ix < nprocs; ref_ix++) {
+ assert(!proc_refs[ref_ix]->is_free);
+ retval = enif_make_list_cell(env, enif_make_pid(env, &proc_refs[ref_ix]->pid),
+ retval);
+ proc_refs[ref_ix]->is_free = 1;
+ }
+ kill_cnt += nprocs;
+ nprocs = 0;
+ old_nprocs = 0;
+ enif_mutex_unlock(procs_lock);
+
+ return retval;
+ }
+ return enif_make_badarg(env);
+ }
+
+ if (!enif_get_int(env, SelfPix, &self_pix) ||
+ !enif_get_uint(env, Op, &op) ||
+ !enif_get_uint(env, Rnd, &rnd.source))
+ return enif_make_badarg(env);
+
+ rnd.bits_consumed = 0;
+ switch (op) {
+ case 0: { /* add/remove process */
+ ErlNifPid self;
+ enif_self(env, &self);
+
+ ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % FRENZY_PROCS_MAX;
+ enif_mutex_lock(procs_lock);
+ if (procs[self_pix].is_free || procs[self_pix].pid.pid != self.pid) {
+ /* Some one already removed me */
+ enif_mutex_unlock(procs_lock);
+ return atom_done;
+ }
+ if (ref_ix >= nprocs || nprocs < 2) { /* add process */
+ ref_ix = nprocs++;
+ pix = proc_refs[ref_ix] - procs;
+ assert(procs[pix].is_free);
+ if (!enif_get_local_pid(env, NewPid, &procs[pix].pid))
+ abort();
+ procs[pix].is_free = 0;
+ spawn_cnt++;
+ proc_histogram[ref_ix]++;
+ old_nprocs = nprocs;
+ enif_mutex_unlock(procs_lock);
+ DBG_TRACE2("Add pid %T, nprocs = %u\n", NewPid, nprocs);
+ retval = enif_make_uint(env, pix);
+ }
+ else { /* remove process */
+ pix = proc_refs[ref_ix] - procs;
+ if (pix == self_pix) {
+ ref_ix = (ref_ix + 1) % nprocs;
+ pix = proc_refs[ref_ix] - procs;
+ }
+ assert(procs[pix].pid.pid != self.pid);
+ assert(!procs[pix].is_free);
+ retval = enif_make_pid(env, &procs[pix].pid);
+ --nprocs;
+ assert(!proc_refs[nprocs]->is_free);
+ if (ref_ix != nprocs) {
+ struct frenzy_proc* tmp = proc_refs[ref_ix];
+ proc_refs[ref_ix] = proc_refs[nprocs];
+ proc_refs[nprocs] = tmp;
+ }
+ procs[pix].is_free = 1;
+ proc_histogram[nprocs]++;
+ kill_cnt++;
+ enif_mutex_unlock(procs_lock);
+ DBG_TRACE2("Removed pid %T, nprocs = %u\n", retval, nprocs);
+ }
+ break;
+ }
+ case 1:
+ case 2: /* create/delete/lookup resource */
+ rix = rand_bits(&rnd, FRENZY_RESOURCES_MAX_BITS) % FRENZY_RESOURCES_MAX;
+ inc = primes[rand_bits(&rnd, 2)];
+ while (enif_mutex_trylock(resv[rix].lock) == EBUSY) {
+ rix = (rix + inc) % FRENZY_RESOURCES_MAX;
+ }
+ if (resv[rix].stopped) {
+ retval = atom_done;
+ enif_mutex_unlock(resv[rix].lock);
+ break;
+ }
+ else if (resv[rix].obj == NULL) {
+ r = enif_alloc_resource(frenzy_resource_type,
+ sizeof(struct frenzy_resource));
+ resv[rix].obj = r;
+ resv[rix].alloc_cnt++;
+ r->rix = rix;
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ r->monv[mix].lock = enif_mutex_create("nif_SUITE:monitor_frenzy.monv.lock");
+ r->monv[mix].state = MON_FREE;
+ r->monv[mix].use_cnt = 0;
+ r->monv[mix].pid.pid = 0; /* null-pid */
+ }
+ DBG_TRACE2("New resource at r=%p rix=%u\n", r, rix);
+ }
+ else {
+ unsigned int resource_op = rand_bits(&rnd, 3);
+ r = resv[rix].obj;
+ if (resource_op == 0) { /* delete resource */
+ resv[rix].obj = NULL;
+ resv[rix].release_cnt++;
+ enif_mutex_unlock(resv[rix].lock);
+ DBG_TRACE2("Delete resource at r=%p rix=%u\n", r, rix);
+ enif_release_resource(r);
+ retval = atom_ok;
+ break;
+ }
+ else if (resource_op == 1) { /* return resource */
+ retval = enif_make_resource(env, r);
+ enif_mutex_unlock(resv[rix].lock);
+ break;
+ }
+ }
+ enif_keep_resource(r);
+ enif_mutex_unlock(resv[rix].lock);
+
+ /* monitor/demonitor */
+
+ mix = rand_bits(&rnd, FRENZY_MONITORS_MAX_BITS) % FRENZY_MONITORS_MAX;
+ inc = primes[rand_bits(&rnd, 2)];
+ while (enif_mutex_trylock(r->monv[mix].lock) == EBUSY) {
+ mix = (mix + inc) % FRENZY_MONITORS_MAX;
+ }
+ switch (r->monv[mix].state) {
+ case MON_FREE:
+ case MON_FREE_DOWN:
+ case MON_FREE_DEMONITOR: { /* do monitor */
+ /*
+ * Use an old possibly larger value of 'nprocs', to increase
+ * probability of monitoring an already terminated process
+ */
+ my_nprocs = old_nprocs;
+ if (my_nprocs > 0) {
+ int save_state = r->monv[mix].state;
+ ref_ix = rand_bits(&rnd, FRENZY_PROCS_MAX_BITS) % my_nprocs;
+ pix = proc_refs[ref_ix] - procs;
+ r->monv[mix].pid.pid = procs[pix].pid.pid; /* "atomic" */
+ r->monv[mix].state = MON_TRYING;
+ rv = enif_monitor_process(env, r, &r->monv[mix].pid, &r->monv[mix].mon);
+ if (rv == 0) {
+ r->monv[mix].state = MON_ACTIVE;
+ r->monv[mix].use_cnt++;
+ DBG_TRACE3("Monitor from r=%p rix=%u to %T\n",
+ r, r->rix, r->monv[mix].pid.pid);
+ }
+ else {
+ r->monv[mix].state = save_state;
+ DBG_TRACE4("Monitor from r=%p rix=%u to %T FAILED with %d\n",
+ r, r->rix, r->monv[mix].pid.pid, rv);
+ }
+ retval = enif_make_int(env,rv);
+ }
+ else {
+ DBG_TRACE0("No pids to monitor\n");
+ retval = atom_ok;
+ }
+ break;
+ }
+ case MON_ACTIVE: /* do demonitor */
+ rv = enif_demonitor_process(env, r, &r->monv[mix].mon);
+ if (rv == 0) {
+ DBG_TRACE3("Demonitor from r=%p rix=%u to %T\n",
+ r, r->rix, r->monv[mix].pid.pid);
+ r->monv[mix].state = MON_FREE_DEMONITOR;
+ }
+ else {
+ DBG_TRACE4("Demonitor from r=%p rix=%u to %T FAILED with %d\n",
+ r, r->rix, r->monv[mix].pid.pid, rv);
+ r->monv[mix].state = MON_PENDING;
+ }
+ retval = enif_make_int(env,rv);
+ break;
+
+ case MON_PENDING: /* waiting for 'down' callback, do nothing */
+ retval = atom_ok;
+ break;
+ default:
+ abort();
+ break;
+ }
+ enif_mutex_unlock(r->monv[mix].lock);
+ enif_release_resource(r);
+ break;
+
+ case 3: /* no-op */
+ retval = atom_ok;
+ break;
+ }
+
+ {
+ int percent = (rand_bits(&rnd, 6) + 1) * 2; /* 2 to 128 */
+ if (percent <= 100)
+ enif_consume_timeslice(env, percent);
+ }
+
+ return retval;
+}
+
+static void frenzy_resource_dtor(ErlNifEnv* env, void* obj)
+{
+ struct frenzy_resource* r = (struct frenzy_resource*) obj;
+ unsigned int mix;
+
+ DBG_TRACE2("DTOR r=%p rix=%u\n", r, r->rix);
+
+ enif_mutex_lock(resv[r->rix].lock);
+ resv[r->rix].dtor_cnt++;
+ enif_mutex_unlock(resv[r->rix].lock);
+
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ assert(r->monv[mix].state != MON_PENDING);
+ enif_mutex_destroy(r->monv[mix].lock);
+ r->monv[mix].lock = NULL;
+ }
+
+}
+
+static void frenzy_resource_down(ErlNifEnv* env, void* obj, ErlNifPid* pid,
+ ErlNifMonitor* mon)
+{
+ struct frenzy_resource* r = (struct frenzy_resource*) obj;
+ unsigned int mix;
+
+ DBG_TRACE3("DOWN pid=%T, r=%p rix=%u\n", pid->pid, r, r->rix);
+
+ for (mix = 0; mix < FRENZY_MONITORS_MAX; mix++) {
+ if (r->monv[mix].pid.pid == pid->pid && r->monv[mix].state >= MON_TRYING) {
+ enif_mutex_lock(r->monv[mix].lock);
+ if (enif_compare_monitors(mon, &r->monv[mix].mon) == 0) {
+ assert(r->monv[mix].state >= MON_ACTIVE);
+ r->monv[mix].state = MON_FREE_DOWN;
+ enif_mutex_unlock(r->monv[mix].lock);
+ return;
+ }
+ enif_mutex_unlock(r->monv[mix].lock);
+ }
+ }
+ enif_fprintf(stderr, "DOWN called for unknown monitor\n");
+ abort();
+}
+
+
+
static ErlNifFunc nif_funcs[] =
{
{"lib_version", 0, lib_version},
@@ -2113,7 +2929,20 @@ static ErlNifFunc nif_funcs[] =
{"term_to_binary_nif", 2, term_to_binary},
{"binary_to_term_nif", 3, binary_to_term},
{"port_command_nif", 2, port_command},
- {"format_term_nif", 2, format_term}
+ {"format_term_nif", 2, format_term},
+ {"select_nif", 5, select_nif},
+#ifndef __WIN32__
+ {"pipe_nif", 0, pipe_nif},
+ {"write_nif", 2, write_nif},
+ {"read_nif", 2, read_nif},
+ {"is_closed_nif", 1, is_closed_nif},
+#endif
+ {"last_fd_stop_call", 0, last_fd_stop_call},
+ {"alloc_monitor_resource_nif", 0, alloc_monitor_resource_nif},
+ {"monitor_process_nif", 4, monitor_process_nif},
+ {"demonitor_process_nif", 2, demonitor_process_nif},
+ {"compare_monitors_nif", 2, compare_monitors_nif},
+ {"monitor_frenzy_nif", 4, monitor_frenzy_nif}
};
ERL_NIF_INIT(nif_SUITE,nif_funcs,load,NULL,upgrade,unload)
diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c
index e6106b6036..04699d3327 100644
--- a/erts/emulator/test/nif_SUITE_data/nif_mod.c
+++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c
@@ -176,6 +176,7 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info, int* retvalp)
CHECK(enif_is_empty_list(env, head));
}
+#if NIF_LIB_VER != 3
static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info)
{
NifModPrivData* data;
@@ -230,6 +231,7 @@ static void unload(ErlNifEnv* env, void* priv)
add_call(env, data, "unload");
NifModPrivData_release(data);
}
+#endif /* NIF_LIB_VER != 3 */
static ERL_NIF_TERM lib_version(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index e495f587a3..152ece5d25 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -53,7 +53,8 @@ XML_REF3_FILES = ct.xml \
ct_slave.xml \
ct_property_test.xml \
ct_netconfc.xml \
- ct_hooks.xml
+ ct_hooks.xml \
+ ct_testspec.xml
XML_REF6_FILES = common_test_app.xml
XML_PART_FILES = part.xml
diff --git a/lib/common_test/doc/src/ct_testspec.xml b/lib/common_test/doc/src/ct_testspec.xml
new file mode 100644
index 0000000000..36893f66cf
--- /dev/null
+++ b/lib/common_test/doc/src/ct_testspec.xml
@@ -0,0 +1,84 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE erlref SYSTEM "erlref.dtd">
+
+<erlref>
+ <header>
+ <copyright>
+ <year>2016</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ Licensed under the Apache License, Version 2.0 (the "License");
+ you may not use this file except in compliance with the License.
+ You may obtain a copy of the License at
+
+ http://www.apache.org/licenses/LICENSE-2.0
+
+ Unless required by applicable law or agreed to in writing, software
+ distributed under the License is distributed on an "AS IS" BASIS,
+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ See the License for the specific language governing permissions and
+ limitations under the License.
+
+ </legalnotice>
+
+ <title>ct_testspec</title>
+ <prepared></prepared>
+ <responsible></responsible>
+ <docno></docno>
+ <approved></approved>
+ <checked></checked>
+ <date></date>
+ <rev>A</rev>
+ <file>ct_testspec.xml</file>
+ </header>
+ <module>ct_testspec</module>
+ <modulesummary>Parsing of test specifications for Common Test.
+ </modulesummary>
+
+<description>
+
+ <p>Parsing of test specifications for <c>Common Test</c>.</p>
+
+ <p>This module exports help functions for parsing of test specifications.</p>
+
+</description>
+
+ <funcs>
+ <func>
+ <name>get_tests(SpecsIn) -&gt; {ok, [{Specs,Tests}]} | {error, Reason}</name>
+ <fsummary>Parse the given test specification files and return the tests to run and skip.</fsummary>
+ <type>
+ <v>SpecsIn = [string()] | [[string()]]</v>
+ <v>Specs = [string()]</v>
+ <v>Test = [{Node,Run,Skip}]</v>
+ <v>Node = atom()</v>
+ <v>Run = {Dir,Suites,Cases}</v>
+ <v>Skip = {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment}</v>
+ <v>Dir = string()</v>
+ <v>Suites = atom | [atom()] | all</v>
+ <v>Cases = atom | [atom()] | all</v>
+ <v>Comment = string()</v>
+ <v>Reason = term()</v>
+ </type>
+ <desc><marker id="add_nodes-1"/>
+ <p>Parse the given test specification files and return the
+ tests to run and skip.</p>
+
+ <p>If <c>SpecsIn=[Spec1,Spec2,...]</c>, separate tests will be
+ created per specification. If
+ <c>SpecsIn=[[Spec1,Spec2,...]]</c>, all specifications will be
+ merge into one test.</p>
+
+ <p>For each test, a <c>{Specs,Tests}</c> element is returned,
+ where <c>Specs</c> is a list of all included test
+ specifications, and <c>Tests</c> specifies actual tests to
+ run/skip per node.</p>
+ </desc>
+ </func>
+
+ </funcs>
+
+</erlref>
+
+
diff --git a/lib/common_test/doc/src/ref_man.xml b/lib/common_test/doc/src/ref_man.xml
index d1567e2d3c..1ac20db5c2 100644
--- a/lib/common_test/doc/src/ref_man.xml
+++ b/lib/common_test/doc/src/ref_man.xml
@@ -47,6 +47,7 @@
<xi:include href="ct_slave.xml"/>
<xi:include href="ct_hooks.xml"/>
<xi:include href="ct_property_test.xml"/>
+ <xi:include href="ct_testspec.xml"/>
</application>
diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl
index 991abb0666..16001ce4c8 100644
--- a/lib/common_test/src/ct_testspec.erl
+++ b/lib/common_test/src/ct_testspec.erl
@@ -26,7 +26,8 @@
-export([prepare_tests/1, prepare_tests/2,
collect_tests_from_list/2, collect_tests_from_list/3,
- collect_tests_from_file/2, collect_tests_from_file/3]).
+ collect_tests_from_file/2, collect_tests_from_file/3,
+ get_tests/1]).
-export([testspec_rec2list/1, testspec_rec2list/2]).
@@ -803,6 +804,31 @@ list_nodes(#testspec{nodes=NodeRefs}) ->
lists:map(fun({_Ref,Node}) -> Node end, NodeRefs).
+%%%-----------------------------------------------------------------
+%%% Parse the given test specs and return the complete set of specs
+%%% and tests to run/skip.
+%%% [Spec1,Spec2,...] means create separate tests per spec
+%%% [[Spec1,Spec2,...]] means merge all specs into one
+-spec get_tests(Specs) -> {ok,[{Specs,Tests}]} | {error,Reason} when
+ Specs :: [string()] | [[string()]],
+ Tests :: {Node,Run,Skip},
+ Node :: atom(),
+ Run :: {Dir,Suites,Cases},
+ Skip :: {Dir,Suites,Comment} | {Dir,Suites,Cases,Comment},
+ Dir :: string(),
+ Suites :: atom | [atom()] | all,
+ Cases :: atom | [atom()] | all,
+ Comment :: string(),
+ Reason :: term().
+
+get_tests(Specs) ->
+ case collect_tests_from_file(Specs,true) of
+ Tests when is_list(Tests) ->
+ {ok,[{S,prepare_tests(R)} || {S,R} <- Tests]};
+ Error ->
+ Error
+ end.
+
%% -----------------------------------------------------
%% / \
%% | When adding test/config terms, remember to update |
diff --git a/lib/common_test/test/ct_testspec_2_SUITE.erl b/lib/common_test/test/ct_testspec_2_SUITE.erl
index 1a941df185..1bab80942a 100644
--- a/lib/common_test/test/ct_testspec_2_SUITE.erl
+++ b/lib/common_test/test/ct_testspec_2_SUITE.erl
@@ -220,7 +220,24 @@ basic_compatible_no_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,Run,Skip}]}] = Tests,
+ [{Alias1V,x_SUITE,all},
+ {Alias1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {Alias1V,z_SUITE,all},
+ {Alias2V,x_SUITE,all},
+ {Alias2V,y_SUITE,all}] = lists:sort(Run),
+ [{Alias1V,z_SUITE,"skipped"},
+ {Alias2V,x_SUITE,{g1,all},"skipped"},
+ {Alias2V,x_SUITE,{g2,all},"skipped"},
+ {Alias2V,y_SUITE,tc1,"skipped"},
+ {Alias2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip),
+
+ ok.
+
%%%-----------------------------------------------------------------
%%%
@@ -346,7 +363,25 @@ basic_compatible_nodes(_Config) ->
{tc2,{skip,"skipped"}}]}]}],
merge_tests = true},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -439,7 +474,28 @@ no_merging(_Config) ->
[{y_SUITE,[{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,ListResult,FileResult).
+ verify_result(Verify,ListResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([SpecFile]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[tc1,tc2]},
+ {TO1V,y_SUITE,[{g1,all},{g2,all}]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,x_SUITE,[{skipped,g1,all},{skipped,g2,all}]},
+ {TO2V,y_SUITE,all},
+ {TO2V,y_SUITE,[{skipped,tc1},{skipped,tc2}]}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
@@ -510,7 +566,25 @@ multiple_specs(_Config) ->
{y_SUITE,[all,{tc1,{skip,"skipped"}},
{tc2,{skip,"skipped"}}]}]}]},
- verify_result(Verify,FileResult,FileResult).
+ verify_result(Verify,FileResult,FileResult),
+
+ {ok,Tests} = ct_testspec:get_tests([[SpecFile1,SpecFile2]]),
+ ct:pal("ct_testspec:get_tests/1:~n~p~n", [Tests]),
+ [{[SpecFile1,SpecFile2],[{Node,[],[]},
+ {Node1,Run1,Skip1},
+ {Node2,Run2,Skip2}]}] = Tests,
+ [{TO1V,x_SUITE,all},
+ {TO1V,y_SUITE,[{g1,all},{g2,all},tc1,tc2]},
+ {TO1V,z_SUITE,all}] = lists:sort(Run1),
+ [{TO2V,x_SUITE,all},
+ {TO2V,y_SUITE,all}] = lists:sort(Run2),
+ [{TO1V,z_SUITE,"skipped"}] = lists:sort(Skip1),
+ [{TO2V,x_SUITE,{g1,all},"skipped"},
+ {TO2V,x_SUITE,{g2,all},"skipped"},
+ {TO2V,y_SUITE,tc1,"skipped"},
+ {TO2V,y_SUITE,tc2,"skipped"}] = lists:sort(Skip2),
+
+ ok.
%%%-----------------------------------------------------------------
%%%
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index c3ffcb3f70..7e83b17add 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -298,12 +298,11 @@ get_data(Port, MonRef, Eot, Sofar) ->
more ->
get_data(Port, MonRef, Eot, [Sofar,Bytes]);
Last ->
- Port ! {self(), close},
- flush_until_closed(Port),
- flush_exit(Port),
+ catch port_close(Port),
+ flush_until_down(Port, MonRef),
iolist_to_binary([Sofar, Last])
end;
- {'DOWN', MonRef, _, _ , _} ->
+ {'DOWN', MonRef, _, _, _} ->
flush_exit(Port),
iolist_to_binary(Sofar)
end.
@@ -317,18 +316,25 @@ eot(Bs, Eot) ->
binary:part(Bs,{0, Pos})
end.
-flush_until_closed(Port) ->
+%% When port_close returns we know that all the
+%% messages sent have been sent and that the
+%% DOWN message is after them all.
+flush_until_down(Port, MonRef) ->
receive
{Port, {data, _Bytes}} ->
- flush_until_closed(Port);
- {Port, closed} ->
- true
+ flush_until_down(Port, MonRef);
+ {'DOWN', MonRef, _, _, _} ->
+ flush_exit(Port)
end.
+%% The exit signal is always delivered before
+%% the down signal, so we can be sure that if there
+%% was an exit message sent, it will be in the
+%% mailbox now.
flush_exit(Port) ->
receive
{'EXIT', Port, _} ->
ok
- after 1 -> % force context switch
+ after 0 ->
ok
end.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index f368232bfc..1f4591a5a3 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -621,20 +621,28 @@ sticky_compiler(Files, PrivDir) ->
[R || R <- Rets, R =/= ok].
do_sticky_compile(Mod, Dir) ->
- %% Make sure that the module is loaded. A module being sticky
- %% only prevents it from begin reloaded, not from being loaded
- %% from the wrong place to begin with.
- Mod = Mod:module_info(module),
- File = filename:append(Dir, atom_to_list(Mod)),
- Src = io_lib:format("-module(~s).\n"
- "-export([test/1]).\n"
- "test(me) -> fail.\n", [Mod]),
- ok = file:write_file(File++".erl", Src),
- case c:c(File, [{outdir,Dir}]) of
- {ok,Module} ->
- Module:test(me);
- {error,sticky_directory} ->
- ok
+ case code:is_sticky(Mod) of
+ true ->
+ %% Make sure that the module is loaded. A module being sticky
+ %% only prevents it from begin reloaded, not from being loaded
+ %% from the wrong place to begin with.
+ Mod = Mod:module_info(module),
+ File = filename:append(Dir, atom_to_list(Mod)),
+ Src = io_lib:format("-module(~s).\n"
+ "-export([test/1]).\n"
+ "test(me) -> fail.\n", [Mod]),
+ ok = file:write_file(File++".erl", Src),
+ case c:c(File, [{outdir,Dir}]) of
+ {ok,Module} ->
+ Module:test(me);
+ {error,sticky_directory} ->
+ ok
+ end;
+ false ->
+ %% For some reason the module is not sticky
+ %% could be that the .erlang file has
+ %% unstuck it?
+ {Mod, is_not_sticky}
end.
%% Test that the -pa and -pz options work as expected.
diff --git a/lib/ssl/doc/src/ssl_session_cache_api.xml b/lib/ssl/doc/src/ssl_session_cache_api.xml
index b85d8fb284..1b41eae89d 100644
--- a/lib/ssl/doc/src/ssl_session_cache_api.xml
+++ b/lib/ssl/doc/src/ssl_session_cache_api.xml
@@ -11,7 +11,7 @@
Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at
-
+
http://www.apache.org/licenses/LICENSE-2.0
Unless required by applicable law or agreed to in writing, software
@@ -62,8 +62,8 @@
</taglist>
</section>
-
- <funcs>
+
+ <funcs>
<func>
<name>delete(Cache, Key) -> _</name>
@@ -134,7 +134,7 @@
</p>
</desc>
</func>
-
+
<func>
<name>select_session(Cache, PartialKey) -> [session()]</name>
<fsummary>Selects sessions that can be reused.</fsummary>
@@ -151,6 +151,21 @@
</func>
<func>
+ <name>size(Cache) -> integer()</name>
+ <fsummary>Returns the number of sessions in the cache.</fsummary>
+ <type>
+ <v>Cache = cache_ref()</v>
+ </type>
+ <desc>
+ <p>Returns the number of sessions in the cache. If size
+ exceeds the maximum number of sessions, the current cache
+ entries will be invalidated regardless of their remaining
+ lifetime. Is to be callable from any process.
+ </p>
+ </desc>
+ </func>
+
+ <func>
<name>terminate(Cache) -> _</name>
<fsummary>Called by the process that handles the cache when it
is about to terminate.</fsummary>
@@ -178,7 +193,7 @@
</p>
</desc>
</func>
-
- </funcs>
-
+
+ </funcs>
+
</erlref>
diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl
index e2e224ab0c..f52ee06e71 100644
--- a/lib/ssl/src/tls_v1.erl
+++ b/lib/ssl/src/tls_v1.erl
@@ -204,21 +204,21 @@ suites(Minor) when Minor == 1; Minor == 2 ->
?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA,
?TLS_RSA_WITH_AES_256_CBC_SHA,
- ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
- ?TLS_RSA_WITH_3DES_EDE_CBC_SHA,
-
?TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA,
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA,
?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA,
?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA,
- ?TLS_RSA_WITH_AES_128_CBC_SHA
+ ?TLS_RSA_WITH_AES_128_CBC_SHA,
+
+ ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_RSA_WITH_3DES_EDE_CBC_SHA
];
suites(3) ->
[
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 94376408d1..6ddba8121a 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -139,6 +139,10 @@ max_cs(M, _Len) ->
M.
-define(ATM(T), is_list(element(1, T))).
+-define(ATM_PAIR(Pair),
+ ?ATM(element(2, element(1, Pair))) % Key
+ andalso
+ ?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
@@ -151,9 +155,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}];
-pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)];
+ [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
+ $}];
pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
@@ -178,6 +181,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
[Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)]
end.
+pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "...";
+pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
+ {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
+ [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
+
+pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+ ",...";
+pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ [$,, write_pair(P) |
+ pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)];
+ true ->
+ {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0),
+ [$,, $\n, Ind, PS |
+ pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
+ end.
+
+pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ {write_pair(Pair), if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll % force nl
+ end};
+pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+ I = map_value_indent(TInd),
+ Ind = indent(I, Ind0),
+ {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
+ Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl
+
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
@@ -216,7 +259,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
end};
pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
- {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
+ Sep = case S of
+ [$\n | _] -> " =";
+ _ -> " = "
+ end,
+ {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
rec_indent(RInd, TInd, Col0, Ind0, W0) ->
%% this uses TInd
@@ -305,8 +352,8 @@ write({{list, L}, _}) ->
[$[, write_list(L, $|), $]];
write({{map, Pairs}, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, K, V}, _}) ->
- [write(K)," => ",write(V)];
+write({{map_pair, _K, _V}, _}=Pair) ->
+ write_pair(Pair);
write({{record, [{Name,_} | L]}, _}) ->
[Name, ${, write_fields(L), $}];
write({{bin, S}, _}) ->
@@ -314,6 +361,9 @@ write({{bin, S}, _}) ->
write({S, _}) ->
S.
+write_pair({{map_pair, K, V}, _}) ->
+ [write(K), " => ", write(V)].
+
write_fields([]) ->
"";
write_fields({dots, _}) ->
@@ -347,7 +397,7 @@ write_tail(E, S) ->
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
-%% format can be formatted. The separators (list, tuple, record) are
+%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
@@ -423,21 +473,32 @@ print_length(Term, _D, _RF, _Enc, _Str) ->
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(maps:to_list(Map), D, RF, Enc, Str),
+ Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str),
{{map, Pairs}, list_length(Pairs, 3)}.
+maps_to_list(Map, D) when D < 0; map_size(Map) =< D ->
+ maps:to_list(Map);
+maps_to_list(Map, D) ->
+ F = fun(_K, _V, {N, L}) when N =:= D ->
+ throw(L);
+ (K, V, {N, L}) ->
+ {N+1, [{K, V} | L]}
+ end,
+ lists:reverse(catch maps:fold(F, {0, []}, Map)).
+
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
{dots, 3};
-print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K,V,D-1,RF,Enc,Str) |
- print_length_map_pairs(Pairs,D-1,RF,Enc,Str)].
+print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
+ [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
+ print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
print_length_map_pair(K, V, D, RF, Enc, Str) ->
{KS, KL} = print_length(K, D, RF, Enc, Str),
{VS, VL} = print_length(V, D, RF, Enc, Str),
- {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}.
+ KL1 = KL + 4,
+ {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
{"{...}", 5};
@@ -630,6 +691,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
+cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+ cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
@@ -655,6 +718,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
throw(no_good)
end.
+cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
+ PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
+ cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
+cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen);
+ true ->
+ PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0),
+ cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW)
+ end;
+cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll
+ end;
+cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+ cind(K, Col0, Ll, M, Ind, LD, W0),
+ I = map_value_indent(Ind),
+ cind(V, Col0 + I, Ll, M, Ind, LD, 0),
+ Ll.
+
+map_value_indent(TInd) ->
+ case TInd > 0 of
+ true ->
+ TInd;
+ false ->
+ 4
+ end.
+
cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
Nind = Nlen + 1,
{Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0),
diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl
index c244e06ca4..cc50e1b52c 100644
--- a/lib/stdlib/src/sofs.erl
+++ b/lib/stdlib/src/sofs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -76,7 +76,7 @@
%%
%% See also "Naive Set Theory" by Paul R. Halmos.
%%
-%% By convention, erlang:error/2 is called from exported functions.
+%% By convention, erlang:error/1 is called from exported functions.
-define(TAG, 'Set').
-define(ORDTAG, 'OrdSet').
@@ -87,12 +87,6 @@
-define(LIST(S), (S)#?TAG.data).
-define(TYPE(S), (S)#?TAG.type).
-%%-define(SET(L, T),
-%% case is_type(T) of
-%% true -> #?TAG{data = L, type = T};
-%% false -> erlang:error(badtype, [T])
-%% end
-%% ).
-define(SET(L, T), #?TAG{data = L, type = T}).
-define(IS_SET(S), is_record(S, ?TAG)).
-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE).
@@ -154,11 +148,8 @@ from_term(T) ->
_ when is_list(T) -> [?ANYTYPE];
_ -> ?ANYTYPE
end,
- case catch setify(T, Type) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
- Set ->
- Set
+ try setify(T, Type)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(from_term(Term, Type) -> AnySet when
@@ -168,14 +159,11 @@ from_term(T) ->
from_term(L, T) ->
case is_type(T) of
true ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
false ->
- erlang:error(badarg, [L, T])
+ erlang:error(badarg)
end.
-spec(from_external(ExternalSet, Type) -> AnySet when
@@ -208,33 +196,26 @@ is_type(_T) ->
Set :: a_set(),
Terms :: [term()]).
set(L) ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L]);
- SL ->
- ?SET(SL, ?ATOM_TYPE)
+ try usort(L) of
+ SL -> ?SET(SL, ?ATOM_TYPE)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(set(Terms, Type) -> Set when
Set :: a_set(),
Terms :: [term()],
Type :: type()).
-set(L, ?SET_OF(Type) = T) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- SL ->
- ?SET(SL, Type)
+set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
+ try usort(L) of
+ SL -> ?SET(SL, Type)
+ catch _:_ -> erlang:error(badarg)
end;
set(L, ?SET_OF(_) = T) ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
-set(L, T) ->
- erlang:error(badarg, [L, T]).
+set(_, _) ->
+ erlang:error(badarg).
-spec(from_sets(ListOfSets) -> Set when
Set :: a_set(),
@@ -245,19 +226,19 @@ set(L, T) ->
from_sets(Ss) when is_list(Ss) ->
case set_of_sets(Ss, [], ?ANYTYPE) of
{error, Error} ->
- erlang:error(Error, [Ss]);
+ erlang:error(Error);
Set ->
Set
end;
from_sets(Tuple) when is_tuple(Tuple) ->
case ordset_of_sets(tuple_to_list(Tuple), [], []) of
error ->
- erlang:error(badarg, [Tuple]);
+ erlang:error(badarg);
Set ->
Set
end;
-from_sets(T) ->
- erlang:error(badarg, [T]).
+from_sets(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples) -> Relation when
Relation :: relation(),
@@ -265,14 +246,11 @@ from_sets(T) ->
relation([]) ->
?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE));
relation(Ts = [T | _]) when is_tuple(T) ->
- case catch rel(Ts, tuple_size(T)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
- Set ->
- Set
+ try rel(Ts, tuple_size(T))
+ catch _:_ -> erlang:error(badarg)
end;
-relation(E) ->
- erlang:error(badarg, [E]).
+relation(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples, Type) -> Relation when
N :: integer(),
@@ -280,24 +258,20 @@ relation(E) ->
Relation :: relation(),
Tuples :: [tuple()]).
relation(Ts, TS) ->
- case catch rel(Ts, TS) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, TS]);
- Set ->
- Set
+ try rel(Ts, TS)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples) -> Function when
Function :: a_function(),
Tuples :: [tuple()]).
a_function(Ts) ->
- case catch func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
- Set ->
- Set
+ erlang:error(Bad);
+ Set ->
+ Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples, Type) -> Function when
@@ -305,26 +279,24 @@ a_function(Ts) ->
Tuples :: [tuple()],
Type :: type()).
a_function(Ts, T) ->
- case catch a_func(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try a_func(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples) -> Family when
Family :: family(),
Tuples :: [tuple()]).
family(Ts) ->
- case catch fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples, Type) -> Family when
@@ -332,13 +304,12 @@ family(Ts) ->
Tuples :: [tuple()],
Type :: type()).
family(Ts, T) ->
- case catch fam(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try fam(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
%%%
@@ -373,7 +344,7 @@ to_sets(S) when ?IS_SET(S) ->
to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []);
to_sets(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(no_elements(ASet) -> NoElements when
ASet :: a_set() | ordset(),
@@ -383,7 +354,7 @@ no_elements(S) when ?IS_SET(S) ->
no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_size(?ORDDATA(S));
no_elements(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(specification(Fun, Set1) -> Set2 when
Fun :: spec_fun(),
@@ -401,7 +372,7 @@ specification(Fun, S) when ?IS_SET(S) ->
SL when is_list(SL) ->
?SET(SL, Type);
Bad ->
- erlang:error(Bad, [Fun, S])
+ erlang:error(Bad)
end.
-spec(union(Set1, Set2) -> Set3 when
@@ -410,7 +381,7 @@ specification(Fun, S) when ?IS_SET(S) ->
Set3 :: a_set()).
union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type)
end.
@@ -420,7 +391,7 @@ union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -430,7 +401,7 @@ intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -440,7 +411,7 @@ difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -452,7 +423,7 @@ symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set5 :: a_set()).
symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type)
end.
@@ -477,11 +448,9 @@ product({S1, S2}) ->
product(S1, S2);
product(T) when is_tuple(T) ->
Ss = tuple_to_list(T),
- case catch sets_to_list(Ss) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
+ try sets_to_list(Ss) of
[] ->
- erlang:error(badarg, [T]);
+ erlang:error(badarg);
L ->
Type = types(Ss, []),
case member([], L) of
@@ -490,6 +459,7 @@ product(T) when is_tuple(T) ->
false ->
?SET(reverse(prod(L, [], [])), Type)
end
+ catch _:_ -> erlang:error(badarg)
end.
-spec(constant_function(Set, AnySet) -> Function when
@@ -502,10 +472,10 @@ constant_function(S, E) when ?IS_SET(S) ->
{Type, true} ->
NType = ?BINREL(Type, type(E)),
?SET(constant_function(?LIST(S), to_external(E), []), NType);
- _ -> erlang:error(badarg, [S, E])
+ _ -> erlang:error(badarg)
end;
-constant_function(S, E) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S, E]).
+constant_function(S, _) when ?IS_ORDSET(S) ->
+ erlang:error(badarg).
-spec(is_equal(AnySet1, AnySet2) -> Bool when
AnySet1 :: anyset(),
@@ -514,17 +484,17 @@ constant_function(S, E) when ?IS_ORDSET(S) ->
is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> ?LIST(S1) == ?LIST(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) ->
case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of
true -> ?ORDDATA(S1) == ?ORDDATA(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) ->
- erlang:error(type_mismatch, [S1, S2]);
+ erlang:error(type_mismatch);
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
- erlang:error(type_mismatch, [S1, S2]).
+ erlang:error(type_mismatch).
-spec(is_subset(Set1, Set2) -> Bool when
Bool :: boolean(),
@@ -533,7 +503,7 @@ is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> subset(?LIST(S1), ?LIST(S2));
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
-spec(is_sofs_set(Term) -> Bool when
@@ -573,7 +543,7 @@ is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[] -> true;
[A | As] -> disjoint(?LIST(S2), A, As)
end;
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
%%%
@@ -587,7 +557,7 @@ union(Sets) when ?IS_SET(Sets) ->
case ?TYPE(Sets) of
?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type);
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
-spec(intersection(SetOfSets) -> Set when
@@ -595,12 +565,12 @@ union(Sets) when ?IS_SET(Sets) ->
SetOfSets :: set_of_sets()).
intersection(Sets) when ?IS_SET(Sets) ->
case ?LIST(Sets) of
- [] -> erlang:error(badarg, [Sets]);
+ [] -> erlang:error(badarg);
[L | Ls] ->
case ?TYPE(Sets) of
?SET_OF(Type) ->
?SET(lintersection(Ls, L), Type);
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end
end.
@@ -614,7 +584,7 @@ canonical_relation(Sets) when ?IS_SET(Sets) ->
?SET_OF(Type) ->
?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST));
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -636,7 +606,7 @@ relation_to_family(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT));
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(domain(BinRel) -> Set when
@@ -646,7 +616,7 @@ domain(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT);
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(range(BinRel) -> Set when
@@ -656,7 +626,7 @@ range(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(field(BinRel) -> Set when
@@ -679,7 +649,7 @@ relative_product(RT) when is_tuple(RT) ->
relative_product(RL) when is_list(RL) ->
case relprod_n(RL, foo, false, false) of
{error, Reason} ->
- erlang:error(Reason, [RL]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -703,11 +673,11 @@ relative_product(RL, R) when is_list(RL), ?IS_SET(R) ->
EmptyR = case ?TYPE(R) of
?BINREL(_, _) -> ?LIST(R) =:= [];
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [RL, R])
+ _ -> erlang:error(badarg)
end,
case relprod_n(RL, R, EmptyR, true) of
{error, Reason} ->
- erlang:error(Reason, [RL, R]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -720,18 +690,18 @@ relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) ->
{DTR1, RTR1} = case ?TYPE(R1) of
?BINREL(_, _) = R1T -> R1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
{DTR2, RTR2} = case ?TYPE(R2) of
?BINREL(_, _) = R2T -> R2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
case match_types(DTR1, DTR2) of
true when DTR1 =:= ?ANYTYPE -> R1;
true when DTR2 =:= ?ANYTYPE -> R2;
true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2));
- false -> erlang:error(type_mismatch, [R1, R2])
+ false -> erlang:error(type_mismatch)
end.
-spec(converse(BinRel1) -> BinRel2 when
@@ -741,7 +711,7 @@ converse(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT));
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(image(BinRel, Set1) -> Set2 when
@@ -755,10 +725,10 @@ image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
true ->
?SET(usort(restrict(?LIST(S), ?LIST(R))), RT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(inverse_image(BinRel, Set1) -> Set2 when
@@ -773,10 +743,10 @@ inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
NL = restrict(?LIST(S), converse(?LIST(R), [])),
?SET(usort(NL), DT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(strict_relation(BinRel1) -> BinRel2 when
@@ -787,7 +757,7 @@ strict_relation(R) when ?IS_SET(R) ->
Type = ?BINREL(_, _) ->
?SET(strict(?LIST(R), []), Type);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(weak_relation(BinRel1) -> BinRel2 when
@@ -798,12 +768,12 @@ weak_relation(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
case unify_types(DT, RT) of
[] ->
- erlang:error(badarg, [R]);
+ erlang:error(badarg);
Type ->
?SET(weak(?LIST(R)), ?BINREL(Type, Type))
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when
@@ -816,7 +786,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
{T=?BINREL(DT, RT), ST, true} ->
case match_types(DT, ST) and match_types(RT, type(E)) of
false ->
- erlang:error(type_mismatch, [R, S, E]);
+ erlang:error(type_mismatch);
true ->
RL = ?LIST(R),
case extc([], ?LIST(S), to_external(E), RL) of
@@ -836,7 +806,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
?SET([], ?BINREL(ST, ET))
end;
{_, _, true} ->
- erlang:error(badarg, [R, S, E])
+ erlang:error(badarg)
end.
-spec(is_a_function(BinRel) -> Bool when
@@ -850,7 +820,7 @@ is_a_function(R) when ?IS_SET(R) ->
[{V,_} | Es] -> is_a_func(Es, V)
end;
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(restriction(BinRel1, Set) -> BinRel2 when
@@ -879,12 +849,12 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of
?BINREL(_, _) = F1T -> F1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of
?BINREL(_, _) = F2T -> F2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
case match_types(RTF1, DTF2) of
true when DTF1 =:= ?ANYTYPE -> Fn1;
@@ -894,9 +864,9 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
SL when is_list(SL) ->
?SET(sort(SL), ?BINREL(DTF1, RTF2));
Bad ->
- erlang:error(Bad, [Fn1, Fn2])
+ erlang:error(Bad)
end;
- false -> erlang:error(type_mismatch, [Fn1, Fn2])
+ false -> erlang:error(type_mismatch)
end.
-spec(inverse(Function1) -> Function2 when
@@ -909,10 +879,10 @@ inverse(Fn) when ?IS_SET(Fn) ->
SL when is_list(SL) ->
?SET(SL, ?BINREL(RT, DT));
Bad ->
- erlang:error(Bad, [Fn])
+ erlang:error(Bad)
end;
?ANYTYPE -> Fn;
- _ -> erlang:error(badarg, [Fn])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -932,7 +902,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -945,7 +915,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -963,28 +933,27 @@ restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(restrict(?LIST(S2), converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
R1 = inverse_substitution(SL1, XFun, Sort),
?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1000,7 +969,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1013,7 +982,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1032,20 +1001,18 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(diff_restrict(SL2, converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1053,8 +1020,9 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
SL2 = ?LIST(S2),
?SET(sort(Sort, diff_restrict(SL2, R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1068,7 +1036,7 @@ projection(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_ when I =:= 1 ->
?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type));
_ ->
@@ -1087,7 +1055,7 @@ substitution(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_Sort ->
NType = ?REL_TYPE(I, Type),
NSL = substitute_element(?LIST(Set), I, []),
@@ -1102,22 +1070,21 @@ substitution(SetFun, Set) when ?IS_SET(Set) ->
{SL, NewType} ->
?SET(reverse(SL), ?BINREL(Type, NewType));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type),
- case catch check_fun(Type, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, FunT) of
_Sort ->
SL = substitute(L, XFun, []),
?SET(SL, ?BINREL(Type, FunT))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1139,7 +1106,7 @@ partition(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % I =:= 1
?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type));
true ->
@@ -1161,7 +1128,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
{R, R};
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1176,7 +1143,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
[L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []),
{?SET(L1, RT), ?SET(L2, RT)};
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1195,20 +1162,18 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
{S1, S1};
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1216,8 +1181,9 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1234,7 +1200,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
MProd = mul_relprod(tuple_to_list(T), 1, R),
relative_product(MProd);
false ->
- erlang:error(badarg, [T, R])
+ erlang:error(badarg)
end.
-spec(join(Relation1, I, Relation2, J) -> Relation3 when
@@ -1246,8 +1212,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
join(R1, I1, R2, I2)
when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) ->
case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of
- false ->
- erlang:error(badarg, [R1, I1, R2, I2]);
+ false -> erlang:error(badarg);
true when ?TYPE(R1) =:= ?ANYTYPE -> R1;
true when ?TYPE(R2) =:= ?ANYTYPE -> R2;
true ->
@@ -1294,7 +1259,7 @@ family_to_relation(F) when ?IS_SET(F) ->
?FAMILY(DT, RT) ->
?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_specification(Fun, Family1) -> Family2 when
@@ -1314,10 +1279,10 @@ family_specification(Fun, F) when ?IS_SET(F) ->
SL when is_list(SL) ->
?SET(SL, FType);
Bad ->
- erlang:error(Bad, [Fun, F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [Fun, F])
+ _ -> erlang:error(badarg)
end.
-spec(union_of_family(Family) -> Set when
@@ -1328,7 +1293,7 @@ union_of_family(F) when ?IS_SET(F) ->
?FAMILY(_DT, Type) ->
?SET(un_of_fam(?LIST(F), []), Type);
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(intersection_of_family(Family) -> Set when
@@ -1341,9 +1306,9 @@ intersection_of_family(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, Type);
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_union(Family1) -> Family2 when
@@ -1354,7 +1319,7 @@ family_union(F) when ?IS_SET(F) ->
?FAMILY(DT, ?SET_OF(Type)) ->
?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_intersection(Family1) -> Family2 when
@@ -1367,10 +1332,10 @@ family_intersection(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, ?FAMILY(DT, Type));
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_domain(Family1) -> Family2 when
@@ -1382,7 +1347,7 @@ family_domain(F) when ?IS_SET(F) ->
?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_range(Family1) -> Family2 when
@@ -1394,7 +1359,7 @@ family_range(F) when ?IS_SET(F) ->
?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_field(Family1) -> Family2 when
@@ -1428,12 +1393,12 @@ family_difference(F1, F2) ->
fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) ->
case unify_types(?TYPE(F1), ?TYPE(F2)) of
[] ->
- erlang:error(type_mismatch, [F1, F2]);
+ erlang:error(type_mismatch);
?ANYTYPE ->
F1;
Type = ?FAMILY(_, _) ->
?SET(FF(?LIST(F1), ?LIST(F2), []), Type);
- _ -> erlang:error(badarg, [F1, F2])
+ _ -> erlang:error(badarg)
end.
-spec(partition_family(SetFun, Set) -> Family when
@@ -1446,7 +1411,7 @@ partition_family(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % when I =:= 1
?SET(fam_partition_n(I, ?LIST(Set)),
?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type)));
@@ -1464,23 +1429,22 @@ partition_family(SetFun, Set) when ?IS_SET(Set) ->
P = fam_partition(converse(NSL, []), true),
?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type)));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
DType = XFun(Type),
- case catch check_fun(Type, XFun, DType) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, DType) of
Sort ->
Ts = inverse_substitution(?LIST(Set), XFun, Sort),
P = fam_partition(Ts, Sort),
?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type)))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1499,13 +1463,13 @@ family_projection(SetFun, F) when ?IS_SET(F) ->
{SL, NewType} ->
?SET(SL, ?BINREL(DT, NewType));
Bad ->
- erlang:error(Bad, [SetFun, F])
+ erlang:error(Bad)
end;
_ ->
- erlang:error(badarg, [SetFun, F])
+ erlang:error(badarg)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [SetFun, F])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -1519,7 +1483,7 @@ family_to_digraph(F) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> fam2digraph(F, digraph:new());
?ANYTYPE -> digraph:new();
- _Else -> erlang:error(badarg, [F])
+ _Else -> erlang:error(badarg)
end.
-spec(family_to_digraph(Family, GraphType) -> Graph when
@@ -1530,27 +1494,27 @@ family_to_digraph(F, Type) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> ok;
?ANYTYPE -> ok;
- _Else -> erlang:error(badarg, [F, Type])
+ _Else -> erlang:error(badarg)
end,
try digraph:new(Type) of
G -> case catch fam2digraph(F, G) of
{error, Reason} ->
true = digraph:delete(G),
- erlang:error(Reason, [F, Type]);
+ erlang:error(Reason);
_ ->
G
end
catch
- error:badarg -> erlang:error(badarg, [F, Type])
+ error:badarg -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph) -> Family when
Graph :: digraph:graph(),
Family :: family()).
digraph_to_family(G) ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G]);
+ try digraph_family(G) of
L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE))
+ catch _:_ -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph, Type) -> Family when
@@ -1560,12 +1524,12 @@ digraph_to_family(G) ->
digraph_to_family(G, T) ->
case {is_type(T), T} of
{true, ?SET_OF(?FAMILY(_,_) = Type)} ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G, T]);
+ try digraph_family(G) of
L -> ?SET(L, Type)
+ catch _:_ -> erlang:error(badarg)
end;
_ ->
- erlang:error(badarg, [G, T])
+ erlang:error(badarg)
end.
%%
@@ -1713,14 +1677,15 @@ func_type([], SL, Type, F) ->
setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE ->
?SET(usort(L), Atom);
setify(L, ?SET_OF(Type0)) ->
- case catch is_no_lists(Type0) of
- {'EXIT', _} ->
- {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
- ?SET(Set, Type);
+ try is_no_lists(Type0) of
N when is_integer(N) ->
- rel(L, N, Type0);
+ rel(L, N, Type0);
Sizes ->
make_oset(L, Sizes, L, Type0)
+ catch
+ _:_ ->
+ {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
+ ?SET(Set, Type)
end;
setify(E, Type0) ->
{Type, OrdSet} = make_element(E, Type0, Type0),
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index b0a1e461e3..d546e8fad2 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1, otp_14178_unicode_atoms/1]).
+ maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage, otp_14178_unicode_atoms].
+ format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2127,3 +2127,200 @@ bad_io_lib_format(F, S) ->
error:badarg ->
ok
end.
+
+otp_14175(_Config) ->
+ "..." = p(#{}, 0),
+ "#{}" = p(#{}, 1),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index 13c12ad2f2..f67bf16f0f 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1837,11 +1837,8 @@ digraph(Conf) when is_list(Conf) ->
ok.
digraph_fail(ExitReason, Fail) ->
- {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail,
- case {test_server:is_native(sofs),A} of
- {false,[_,_]} -> ok;
- {true,2} -> ok
- end.
+ {'EXIT', {ExitReason, [{sofs,family_to_digraph,2,_}|_]}} = Fail,
+ ok.
constant_function(Conf) when is_list(Conf) ->
E = empty_set(),
diff --git a/lib/xmerl/src/xmerl_sax_parser.erl b/lib/xmerl/src/xmerl_sax_parser.erl
index 318a0cf7f4..1aef6c58c4 100644
--- a/lib/xmerl/src/xmerl_sax_parser.erl
+++ b/lib/xmerl/src/xmerl_sax_parser.erl
@@ -1,7 +1,7 @@
%%--------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -33,6 +33,7 @@
%% External exports
%%----------------------------------------------------------------------
-export([file/2,
+ stream/3,
stream/2]).
%%----------------------------------------------------------------------
@@ -72,11 +73,12 @@ file(Name,Options) ->
File = filename:basename(Name),
ContinuationFun = fun default_continuation_cb/1,
Res = stream(<<>>,
- [{continuation_fun, ContinuationFun},
- {continuation_state, FD},
- {current_location, CL},
- {entity, File}
- |Options]),
+ [{continuation_fun, ContinuationFun},
+ {continuation_state, FD},
+ {current_location, CL},
+ {entity, File}
+ |Options],
+ file),
ok = file:close(FD),
Res
end.
@@ -92,19 +94,22 @@ file(Name,Options) ->
%% EventState = term()
%% Description: Parse a stream containing an XML document.
%%----------------------------------------------------------------------
-stream(Xml, Options) when is_list(Xml), is_list(Options) ->
+stream(Xml, Options) ->
+ stream(Xml, Options, stream).
+
+stream(Xml, Options, InputType) when is_list(Xml), is_list(Options) ->
State = parse_options(Options, initial_state()),
- case State#xmerl_sax_parser_state.file_type of
+ case State#xmerl_sax_parser_state.file_type of
dtd ->
xmerl_sax_parser_list:parse_dtd(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream});
+ input_type = InputType});
normal ->
xmerl_sax_parser_list:parse(Xml,
State#xmerl_sax_parser_state{encoding = list,
- input_type = stream})
+ input_type = InputType})
end;
-stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
+stream(Xml, Options, InputType) when is_binary(Xml), is_list(Options) ->
case parse_options(Options, initial_state()) of
{error, Reason} -> {error, Reason};
State ->
@@ -127,7 +132,7 @@ stream(Xml, Options) when is_binary(Xml), is_list(Options) ->
State#xmerl_sax_parser_state.event_state};
{Xml1, State1} ->
parse_binary(Xml1,
- State1#xmerl_sax_parser_state{input_type = stream},
+ State1#xmerl_sax_parser_state{input_type = InputType},
ParseFunction)
end
end.
@@ -226,12 +231,12 @@ check_encoding_option(E) ->
%% Description: Detects which character set is used in a binary stream.
%%----------------------------------------------------------------------
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = undefined} = _) ->
- throw({error, "Can't detect character encoding due to no indata"});
+ {error, "Can't detect character encoding due to no indata"};
detect_charset(<<>>, #xmerl_sax_parser_state{continuation_fun = CFun,
continuation_state = CState} = State) ->
case CFun(CState) of
{<<>>, _} ->
- throw({error, "Can't detect character encoding due to lack of indata"});
+ {error, "Can't detect character encoding due to lack of indata"};
{NewBytes, NewContState} ->
detect_charset(NewBytes, State#xmerl_sax_parser_state{continuation_state = NewContState})
end;
diff --git a/lib/xmerl/src/xmerl_sax_parser.hrl b/lib/xmerl/src/xmerl_sax_parser.hrl
index 932ab0cec5..7f9bf6c4d3 100644
--- a/lib/xmerl/src/xmerl_sax_parser.hrl
+++ b/lib/xmerl/src/xmerl_sax_parser.hrl
@@ -88,14 +88,7 @@
current_location, % Location of the currently parsed XML entity
entity, % Parsed XML entity
skip_external_dtd = false,% If true the external DTD is skipped during parsing
- input_type % Source type: file | stream.
- % This field is a preparation for an fix in R17 of a bug in
- % the conformance against the standard.
- % Today a file which contains two XML documents will be considered
- % well-formed and the second is placed in the rest part of the
- % return tuple, according to the conformance tests this should fail.
- % In the future this will fail if xmerl_sax_aprser:file/2 is used but
- % left to the user in the xmerl_sax_aprser:stream/2 case.
+ input_type % Source type: file | stream
}).
diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
index 4d75805b9b..2b9b37b5f3 100644
--- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
+++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc
@@ -1,7 +1,7 @@
%%-*-erlang-*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -72,7 +72,12 @@ parse(Xml, State) ->
{ok, Rest, State2} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ case check_if_rest_ok(State3#xmerl_sax_parser_state.input_type, Rest) of
+ true ->
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ false ->
+ format_error(fatal_error, State3, "Input found after legal document")
+ end;
{fatal_error, {State2, Reason}} ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -81,10 +86,14 @@ parse(Xml, State) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
format_error(Tag, State3, Reason);
+ {endDocument, Rest, State2} ->
+ State3 = event_callback(endDocument, State2),
+ ets:delete(RefTable),
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
%%----------------------------------------------------------------------
@@ -111,7 +120,7 @@ parse_dtd(Xml, State) ->
{Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
- {ok, State3#xmerl_sax_parser_state.event_state, Rest};
+ {ok, State3#xmerl_sax_parser_state.event_state, Rest};
{endDocument, Rest, State2} when is_record(State2, xmerl_sax_parser_state) ->
State3 = event_callback(endDocument, State2),
ets:delete(RefTable),
@@ -119,7 +128,7 @@ parse_dtd(Xml, State) ->
Other ->
_State2 = event_callback(endDocument, State1),
ets:delete(RefTable),
- throw(Other)
+ {fatal_error, Other}
end.
@@ -442,6 +451,15 @@ check_if_new_doc_allowed(stream, []) ->
check_if_new_doc_allowed(_, _) ->
false.
+check_if_rest_ok(file, []) ->
+ true;
+check_if_rest_ok(file, <<>>) ->
+ true;
+check_if_rest_ok(stream, _) ->
+ true;
+check_if_rest_ok(_, _) ->
+ false.
+
%%----------------------------------------------------------------------
%% Function: parse_pi_1(Rest, State) -> Result
%% Input: Rest = string() | binary()
@@ -1024,16 +1042,21 @@ parse_etag(Bytes, State) ->
unicode_incomplete_check([Bytes, State, fun parse_etag/2],
undefined).
-
parse_etag_1(?STRING_REST(">", Rest),
#xmerl_sax_parser_state{end_tags=[{_ETag, Uri, LocalName, QName, OldNsList, NewNsList}
- |RestOfETags]} = State, _Tag) ->
+ |RestOfETags],
+ input_type=InputType} = State, _Tag) ->
State1 = event_callback({endElement, Uri, LocalName, QName}, State),
State2 = send_end_prefix_mapping_event(NewNsList, State1),
- parse_content(Rest,
- State2#xmerl_sax_parser_state{end_tags=RestOfETags,
- ns = OldNsList},
- [], true);
+ case check_if_new_doc_allowed(InputType, RestOfETags) of
+ true ->
+ throw({endDocument, Rest, State2#xmerl_sax_parser_state{ns = OldNsList}});
+ false ->
+ parse_content(Rest,
+ State2#xmerl_sax_parser_state{end_tags=RestOfETags,
+ ns = OldNsList},
+ [], true)
+ end;
parse_etag_1(?STRING_UNBOUND_REST(_C, _), State, Tag) ->
{P,TN} = Tag,
?fatal_error(State, "Bad EndTag: " ++ P ++ ":" ++ TN);
@@ -1051,21 +1074,26 @@ parse_etag_1(Bytes, State, Tag) ->
%% Description: Parsing the content part of tags
%% [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
%%----------------------------------------------------------------------
-
parse_content(?STRING_EMPTY, State, Acc, IgnorableWS) ->
- case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
- {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
- {Rest, State1};
- {fatal_error, {State1, Msg}} ->
- case check_if_document_complete(State1, Msg) of
- true ->
- State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
- {?STRING_EMPTY, State2};
- false ->
- ?fatal_error(State1, Msg)
- end;
- Other ->
- throw(Other)
+ case check_if_document_complete(State, "No more bytes") of
+ true ->
+ State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
+ {?STRING_EMPTY, State1};
+ false ->
+ case catch cf(?STRING_EMPTY, State, Acc, IgnorableWS, fun parse_content/4) of
+ {Rest, State1} when is_record(State1, xmerl_sax_parser_state) ->
+ {Rest, State1};
+ {fatal_error, {State1, Msg}} ->
+ case check_if_document_complete(State1, Msg) of
+ true ->
+ State2 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State1),
+ {?STRING_EMPTY, State2};
+ false ->
+ ?fatal_error(State1, Msg)
+ end;
+ Other ->
+ throw(Other)
+ end
end;
parse_content(?STRING("\r") = Bytes, State, Acc, IgnorableWS) ->
cf(Bytes, State, Acc, IgnorableWS, fun parse_content/4);
@@ -1094,7 +1122,7 @@ parse_content(?STRING_REST("<?", Rest), State, Acc, IgnorableWS) ->
parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_cdata(Rest1, State1)
@@ -1102,7 +1130,7 @@ parse_content(?STRING_REST("<!", Rest1) = Rest, #xmerl_sax_parser_state{end_tags
parse_content(?STRING_REST("<", Rest1) = Rest, #xmerl_sax_parser_state{end_tags = ET} = State, Acc, IgnorableWS) ->
case ET of
[] ->
- {Rest, State}; %%LATH : Skicka ignorable WS ???
+ {Rest, State}; %% Skicka ignorable WS ???
_ ->
State1 = send_character_event(length(Acc), IgnorableWS, lists:reverse(Acc), State),
parse_stag(Rest1, State1)
@@ -3290,7 +3318,7 @@ cf(Rest, #xmerl_sax_parser_state{continuation_fun = CFun, continuation_state = C
catch
throw:ErrorTerm ->
?fatal_error(State, ErrorTerm);
- exit:Reason ->
+ exit:Reason ->
?fatal_error(State, {'EXIT', Reason})
end,
case Result of
diff --git a/lib/xmerl/test/Makefile b/lib/xmerl/test/Makefile
index 7a326e334f..b13fee05b3 100644
--- a/lib/xmerl/test/Makefile
+++ b/lib/xmerl/test/Makefile
@@ -55,7 +55,8 @@ SUITE_FILES= \
xmerl_xsd_SUITE.erl \
xmerl_xsd_MS2002-01-16_SUITE.erl \
xmerl_xsd_NIST2002-01-16_SUITE.erl \
- xmerl_xsd_Sun2002-01-16_SUITE.erl
+ xmerl_xsd_Sun2002-01-16_SUITE.erl \
+ xmerl_sax_stream_SUITE.erl
XML_FILES= \
testcases.dtd \
@@ -125,4 +126,5 @@ release_tests_spec: opt
@tar cfh - xmerl_xsd_MS2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_NIST2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
@tar cfh - xmerl_xsd_Sun2002-01-16_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cfh - xmerl_sax_stream_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
chmod -R u+w "$(RELSYSDIR)"
diff --git a/lib/xmerl/test/xmerl_sax_SUITE.erl b/lib/xmerl/test/xmerl_sax_SUITE.erl
index f5c0a783c4..7d1a70905c 100644
--- a/lib/xmerl/test/xmerl_sax_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_SUITE.erl
@@ -85,17 +85,17 @@ ticket_11551(_Config) ->
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
+ {ok, undefined, <<"\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream1, []),
Stream2= <<"<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
+ {ok, undefined, <<"\n\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream2, []),
Stream3= <<"<a>hej</a>
<?xml version=\"1.0\" encoding=\"utf-8\" ?>
<a>hej</a>">>,
- {ok, undefined, <<"<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
+ {ok, undefined, <<"\n\n<?xml", _/binary>>} = xmerl_sax_parser:stream(Stream3, []),
ok.
diff --git a/lib/xmerl/test/xmerl_sax_std_SUITE.erl b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
index 525a3b175a..b8412206cc 100644
--- a/lib/xmerl/test/xmerl_sax_std_SUITE.erl
+++ b/lib/xmerl/test/xmerl_sax_std_SUITE.erl
@@ -2,7 +2,7 @@
%%----------------------------------------------------------------------
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -507,11 +507,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-036'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/036.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -522,11 +519,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-037'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/037.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&#32;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -561,11 +555,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-040'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/040.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -576,11 +567,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-041'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/041.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc></doc>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -603,11 +591,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-043'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/043.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"Illegal data\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -618,11 +603,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-044'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/044.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<doc/>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -669,11 +651,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-048'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/048.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"<![CDATA[]]>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1416,11 +1395,8 @@ end_per_testcase(_Func,_Config) ->
'not-wf-sa-110'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"xmltest","not-wf/sa/110.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"&e;\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -1914,9 +1890,9 @@ end_per_testcase(_Func,_Config) ->
%% Special case becase we returns everything after a legal document
%% as an rest instead of giving and error to let the user handle
%% multipple docs on a stream.
- {ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ %{ok,_,<<"<?xml version=\"1.0\"?>\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -7784,11 +7760,8 @@ end_per_testcase(_Func,_Config) ->
'o-p01fail3'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"oasis","p01fail3.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<bad/>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11417,12 +11390,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n02'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n02.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<?xml version=\"1.0\"?>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- % R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
- % check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Case
@@ -11433,11 +11402,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P01-ibm01n03'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P01/ibm01n03.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<title>Wrong combination!</title>", _/binary>>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13027,11 +12993,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P27-ibm27n01'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P27/ibm27n01.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_, <<"<!ELEMENT cat EMPTY>">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
@@ -13461,11 +13424,8 @@ end_per_testcase(_Func,_Config) ->
'ibm-not-wf-P39-ibm39n06'(Config) ->
file:set_cwd(xmerl_test_lib:get_data_dir(Config)),
Path = filename:join([xmerl_test_lib:get_data_dir(Config),"ibm","not-wf/P39/ibm39n06.xml"]),
- %% Special case becase we returns everything after a legal document
- %% as an rest instead of giving and error to let the user handle
- %% multipple docs on a stream.
- {ok,_,<<"content after end tag\r\n">>} = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]).
- %%check_result(R, "not-wf").
+ R = xmerl_sax_parser:file(Path, [{event_fun, fun(_,_,S) -> S end}]),
+ check_result(R, "not-wf").
%%----------------------------------------------------------------------
%% Test Cases
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE.erl b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
new file mode 100644
index 0000000000..a306eb66a2
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE.erl
@@ -0,0 +1,245 @@
+%%-*-erlang-*-
+%%----------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%----------------------------------------------------------------------
+%% File : xmerl_sax_stream_SUITE.erl
+%%----------------------------------------------------------------------
+-module(xmerl_sax_stream_SUITE).
+-compile(export_all).
+
+%%----------------------------------------------------------------------
+%% Include files
+%%----------------------------------------------------------------------
+-include_lib("common_test/include/ct.hrl").
+-include_lib("kernel/include/file.hrl").
+
+%%======================================================================
+%% External functions
+%%======================================================================
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+all() ->
+ [
+ one_document,
+ two_documents,
+ one_document_and_junk
+ ].
+
+%%----------------------------------------------------------------------
+%% Initializations
+%%----------------------------------------------------------------------
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_Func, _Config) ->
+ ok.
+
+%%----------------------------------------------------------------------
+%% Tests
+%%----------------------------------------------------------------------
+one_document(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n">> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+two_documents(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_two.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\n<?x", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 5000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+one_document_and_junk(Config) ->
+ Port = 11111,
+
+ {ok, ListenSocket} = listen(Port),
+ Self = self(),
+
+ spawn(
+ fun() ->
+ case catch gen_tcp:accept(ListenSocket) of
+ {ok, S} ->
+ Result = xmerl_sax_parser:stream(<<>>,
+ [{continuation_state, S},
+ {continuation_fun,
+ fun(Sd) ->
+ io:format("Continuation called!!", []),
+ case gen_tcp:recv(Sd, 0) of
+ {ok, Packet} ->
+ io:format("Packet: ~p\n", [Packet]),
+ {Packet, Sd};
+ {error, Reason} ->
+ throw({error, Reason})
+ end
+ end}]),
+ Self ! {xmerl_sax, Result},
+ close(S);
+ Error ->
+ Self ! {xmerl_sax, {error, {accept, Error}}}
+ end
+ end),
+
+ {ok, SendSocket} = connect(localhost, Port),
+
+ {ok, Binary} = file:read_file(filename:join([datadir(Config), "xmerl_sax_stream_one_junk.xml"])),
+
+ send_chunks(SendSocket, Binary),
+
+ receive
+ {xmerl_sax, {ok, undefined, Rest}} ->
+ <<"\nth", _R/binary>> = Rest,
+ io:format("Ok Rest: ~p\n", [Rest])
+ after 10000 ->
+ ct:fail("Timeout")
+ end,
+ ok.
+
+%%----------------------------------------------------------------------
+%% Utility functions
+%%----------------------------------------------------------------------
+listen(Port) ->
+ case catch gen_tcp:listen(Port, [{active, false},
+ binary,
+ {keepalive, true},
+ {reuseaddr,true}]) of
+ {ok, ListenSocket} ->
+ {ok, ListenSocket};
+ {error, Reason} ->
+ {error, {listen, Reason}}
+ end.
+
+close(Socket) ->
+ (catch gen_tcp:close(Socket)).
+
+connect(Host, Port) ->
+ Timeout = 5000,
+ % Options1 = check_options(Options),
+ Options = [binary],
+ case catch gen_tcp:connect(Host, Port, Options, Timeout) of
+ {ok, Socket} ->
+ {ok, Socket};
+ {error, Reason} ->
+ {error, Reason}
+ end.
+
+send_chunks(Socket, Binary) ->
+ BSize = erlang:size(Binary),
+ if
+ BSize > 25 ->
+ <<Head:25/binary, Tail/binary>> = Binary,
+ case gen_tcp:send(Socket, Head) of
+ ok ->
+ timer:sleep(1000),
+ send_chunks(Socket, Tail);
+ {error,closed} ->
+ ok
+ end;
+ true ->
+ gen_tcp:send(Socket, Binary)
+ end.
+
+datadir(Config) ->
+ proplists:get_value(data_dir, Config).
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
new file mode 100644
index 0000000000..30328bb188
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one.xml
@@ -0,0 +1,17 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
new file mode 100644
index 0000000000..f730a95865
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_one_junk.xml
@@ -0,0 +1,18 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+this is junk ......
diff --git a/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
new file mode 100644
index 0000000000..e241a02190
--- /dev/null
+++ b/lib/xmerl/test/xmerl_sax_stream_SUITE_data/xmerl_sax_stream_two.xml
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<person>
+<name>
+Arne Andersson
+</name>
+<address>
+<street>
+ Old Road 456
+</street>
+<zip>
+12323
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>
+<?xml version="1.0"?>
+<person>
+<name>
+Bertil Bengtson
+</name>
+<address>
+<street>
+ New Road 4
+</street>
+<zip>
+12328
+</zip>
+<city>
+Small City
+</city>
+</address>
+</person>