aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/doc/src/erl.xml31
-rw-r--r--erts/emulator/beam/atom.names1
-rw-r--r--erts/emulator/beam/break.c39
-rw-r--r--erts/emulator/beam/erl_process_lock.c2
-rwxr-xr-xerts/emulator/beam/global.h3
-rw-r--r--erts/emulator/beam/index.c3
-rw-r--r--erts/emulator/beam/io.c26
-rw-r--r--erts/emulator/beam/sys.h2
-rw-r--r--erts/emulator/sys/unix/sys.c82
-rwxr-xr-xerts/emulator/sys/win32/sys.c19
-rw-r--r--erts/etc/common/heart.c214
-rw-r--r--lib/kernel/doc/src/heart.xml33
-rw-r--r--lib/kernel/src/heart.erl3
-rw-r--r--lib/kernel/test/heart_SUITE.erl401
14 files changed, 597 insertions, 262 deletions
diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml
index 93d1289e8d..7cdb3a4dfe 100644
--- a/erts/doc/src/erl.xml
+++ b/erts/doc/src/erl.xml
@@ -1042,6 +1042,37 @@
the emulator will be allowed to spend writing a crash dump. When
the given number of seconds have elapsed, the emulator will be
terminated by a SIGALRM signal.</p>
+
+ <p> If the environment variable is <em>not</em> set or it is set to zero seconds, <c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c>,
+ the runtime system will not even attempt to write the crash dump file. It will just terminate.
+ </p>
+ <p> If the environment variable is set to negative valie, e.g. <c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c>,
+ the runtime system will wait indefinitely for the crash dump file to be written.
+ </p>
+ <p> This environment variable is used in conjuction with
+ <seealso marker="kernel:heart"><c>heart</c></seealso> if <c>heart</c> is running:
+ </p>
+ <taglist>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c></tag>
+ <item><p>
+ Suppresses the writing a crash dump file entirely,
+ thus rebooting the runtime system immediately.
+ This is the same as not setting the environment variable.
+ </p>
+ </item>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c></tag>
+ <item><p>Setting the environment variable to a negative value will cause the
+ termination of the runtime system to wait until the crash dump file
+ has been completly written.
+ </p>
+ </item>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=S]]></c></tag>
+ <item><p>
+ Will wait for <c>S</c> seconds to complete the crash dump file and
+ then terminate the runtime system.
+ </p>
+ </item>
+ </taglist>
</item>
<tag><c><![CDATA[ERL_AFLAGS]]></c></tag>
<item>
diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names
index 106fad030b..afcbd732df 100644
--- a/erts/emulator/beam/atom.names
+++ b/erts/emulator/beam/atom.names
@@ -252,6 +252,7 @@ atom heap_block_size
atom heap_size
atom heap_sizes
atom heap_type
+atom heart_port
atom heir
atom hidden
atom hide
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index 376201c309..63136d86c9 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -663,10 +663,13 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
ErtsThrPrgrData tpd_buf; /* in case we aren't a managed thread... */
#endif
int fd;
+ size_t envsz;
time_t now;
+ char env[21]; /* enough to hold any 64-bit integer */
size_t dumpnamebufsize = MAXPATHLEN;
char dumpnamebuf[MAXPATHLEN];
char* dumpname;
+ int secs;
if (ERTS_SOMEONE_IS_CRASH_DUMPING)
return;
@@ -689,9 +692,41 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_writing_erl_crash_dump = 1;
#endif
- erts_sys_prepare_crash_dump();
+ envsz = sizeof(env);
+ /* ERL_CRASH_DUMP_SECONDS not set
+ * same as ERL_CRASH_DUMP_SECONDS = 0
+ * - do not write dump
+ * - do not set an alarm
+ * - break immediately
+ *
+ * ERL_CRASH_DUMP_SECONDS = 0
+ * - do not write dump
+ * - do not set an alarm
+ * - break immediately
+ *
+ * ERL_CRASH_DUMP_SECONDS < 0
+ * - do not set alarm
+ * - write dump until done
+ *
+ * ERL_CRASH_DUMP_SECONDS = S (and S positive)
+ * - Don't dump file forever
+ * - set alarm (set in sys)
+ * - write dump until alarm or file is written completely
+ */
+
+ if (erts_sys_getenv__("ERL_CRASH_DUMP_SECONDS", env, &envsz) != 0) {
+ return; /* break immediately */
+ } else {
+ secs = atoi(env);
+ }
+
+ if (secs == 0) {
+ return;
+ }
+
+ erts_sys_prepare_crash_dump(secs);
- if (erts_sys_getenv_raw("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0)
+ if (erts_sys_getenv__("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0)
dumpname = "erl_crash.dump";
else
dumpname = &dumpnamebuf[0];
diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c
index 7777ba1d3d..84a8270d06 100644
--- a/erts/emulator/beam/erl_process_lock.c
+++ b/erts/emulator/beam/erl_process_lock.c
@@ -1587,7 +1587,7 @@ erts_proc_lc_chk_no_proc_locks(char *file, int line)
lc_id.proc_lock_msgq,
lc_id.proc_lock_status};
erts_lc_have_lock_ids(resv, ids, 4);
- if (resv[0] || resv[1] || resv[2] || resv[3]) {
+ if (!ERTS_IS_CRASH_DUMPING && (resv[0] || resv[1] || resv[2] || resv[3])) {
erts_lc_fail("%s:%d: Thread has process locks locked when expected "
"not to have any process locks locked",
file, line);
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 1503d793ab..4c0d3421c8 100755
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -999,6 +999,9 @@ Uint erts_port_ioq_size(Port *pp);
void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int);
void erts_port_cleanup(Port *);
void erts_fire_port_monitor(Port *prt, Eterm ref);
+
+Port *erts_get_heart_port(void);
+
#ifdef ERTS_SMP
void erts_smp_xports_unlock(Port *);
#endif
diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c
index 25d5cce0f3..c981a0a55e 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -82,7 +82,8 @@ index_put_entry(IndexTable* t, void* tmpl)
if (ix >= t->size) {
Uint sz;
if (ix >= t->limit) {
- erl_exit(1, "no more index entries in %s (max=%d)\n",
+ /* A core dump is unnecessary */
+ erl_exit(ERTS_DUMP_EXIT, "no more index entries in %s (max=%d)\n",
t->htable.name, t->limit);
}
sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*);
diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c
index dec51f3be5..60b9238d38 100644
--- a/erts/emulator/beam/io.c
+++ b/erts/emulator/beam/io.c
@@ -1128,7 +1128,7 @@ int erts_write_to_port(Eterm caller_id, Port *p, Eterm list)
Uint size;
int fpe_was_unmasked;
- ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p));
+ ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p) || ERTS_IS_CRASH_DUMPING);
ERTS_SMP_CHK_NO_PROC_LOCKS;
p->caller = caller_id;
@@ -5258,3 +5258,27 @@ erl_drv_getenv(char *key, char *value, size_t *value_size)
{
return erts_sys_getenv_raw(key, value, value_size);
}
+
+/* get heart_port
+ * used by erl_crash_dump
+ * - uses the fact that heart_port is registered when starting heart
+ */
+
+Port *erts_get_heart_port() {
+
+ Port* port;
+ Uint ix;
+
+ for(ix = 0; ix < erts_max_ports; ix++) {
+ port = &erts_port[ix];
+ /* only examine undead or alive ports */
+ if (port->status & ERTS_PORT_SFLGS_DEAD)
+ continue;
+ /* immediate atom compare */
+ if (port->reg && port->reg->name == am_heart_port) {
+ return port;
+ }
+ }
+
+ return NULL;
+}
diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h
index 0e6bec352e..8957bb5bde 100644
--- a/erts/emulator/beam/sys.h
+++ b/erts/emulator/beam/sys.h
@@ -644,7 +644,7 @@ void erts_sys_schedule_interrupt_timed(int set, erts_short_time_t msec);
void erts_sys_main_thread(void);
#endif
-extern void erts_sys_prepare_crash_dump(void);
+extern void erts_sys_prepare_crash_dump(int secs);
extern void erts_sys_pre_init(void);
extern void erl_sys_init(void);
extern void erl_sys_args(int *argc, char **argv);
diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c
index 97756e8434..b485dbf784 100644
--- a/erts/emulator/sys/unix/sys.c
+++ b/erts/emulator/sys/unix/sys.c
@@ -58,7 +58,6 @@
#define __DARWIN__ 1
#endif
-
#ifdef USE_THREADS
#include "erl_threads.h"
#endif
@@ -71,7 +70,6 @@ static erts_smp_rwmtx_t environ_rwmtx;
#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O
* vector sock_sendv().
*/
-
/*
* Don't need global.h, but bif_table.h (included by bif.h),
* won't compile otherwise
@@ -123,6 +121,15 @@ struct ErtsSysReportExit_ {
#endif
};
+/* This data is shared by these drivers - initialized by spawn_init() */
+static struct driver_data {
+ int port_num, ofd, packet_bytes;
+ ErtsSysReportExit *report_exit;
+ int pid;
+ int alive;
+ int status;
+} *driver_data; /* indexed by fd */
+
static ErtsSysReportExit *report_exit_list;
#if CHLDWTHR && !defined(ERTS_SMP)
static ErtsSysReportExit *report_exit_transit_list;
@@ -680,17 +687,40 @@ static RETSIGTYPE break_handler(int sig)
#endif /* 0 */
static ERTS_INLINE void
-prepare_crash_dump(void)
+prepare_crash_dump(int secs)
{
+#define NUFBUF (3)
int i, max;
char env[21]; /* enough to hold any 64-bit integer */
size_t envsz;
+ DeclareTmpHeapNoproc(heap,NUFBUF);
+ Port *heart_port;
+ Eterm *hp = heap;
+ Eterm list = NIL;
+ int heart_fd[2] = {-1,-1};
+
+ UseTmpHeapNoproc(NUFBUF);
if (ERTS_PREPARED_CRASH_DUMP)
return; /* We have already been called */
+ heart_port = erts_get_heart_port();
+ if (heart_port) {
+ /* hearts input fd
+ * We "know" drv_data is the in_fd since the port is started with read|write
+ */
+ heart_fd[0] = (int)heart_port->drv_data;
+ heart_fd[1] = (int)driver_data[heart_fd[0]].ofd;
+
+ list = CONS(hp, make_small(8), list); hp += 2;
+
+ /* send to heart port, CMD = 8, i.e. prepare crash dump =o */
+ erts_write_to_port(ERTS_INVALID_PID, heart_port, list);
+ }
+
/* Make sure we unregister at epmd (unknown fd) and get at least
one free filedescriptor (for erl_crash.dump) */
+
max = max_files;
if (max < 1024)
max = 1024;
@@ -704,11 +734,15 @@ prepare_crash_dump(void)
if (i == async_fd[0] || i == async_fd[1])
continue;
#endif
+ /* We don't want to close our heart yet ... */
+ if (i == heart_fd[0] || i == heart_fd[1])
+ continue;
+
close(i);
}
envsz = sizeof(env);
- i = erts_sys_getenv_raw("ERL_CRASH_DUMP_NICE", env, &envsz);
+ i = erts_sys_getenv__("ERL_CRASH_DUMP_NICE", env, &envsz);
if (i >= 0) {
int nice_val;
nice_val = i != 0 ? 0 : atoi(env);
@@ -717,21 +751,21 @@ prepare_crash_dump(void)
}
erts_silence_warn_unused_result(nice(nice_val));
}
-
- envsz = sizeof(env);
- i = erts_sys_getenv_raw("ERL_CRASH_DUMP_SECONDS", env, &envsz);
- if (i >= 0) {
- unsigned sec;
- sec = (unsigned) i != 0 ? 0 : atoi(env);
- alarm(sec);
- }
+ /* Positive secs means an alarm must be set
+ * 0 or negative means no alarm
+ */
+ if (secs > 0) {
+ alarm((unsigned int)secs);
+ }
+ UnUseTmpHeapNoproc(NUFBUF);
+#undef NUFBUF
}
void
-erts_sys_prepare_crash_dump(void)
+erts_sys_prepare_crash_dump(int secs)
{
- prepare_crash_dump();
+ prepare_crash_dump(secs);
}
static ERTS_INLINE void
@@ -773,7 +807,7 @@ sigusr1_exit(void)
is hung somewhere, so it won't be able to poll any flag we set here.
*/
ERTS_SET_GOT_SIGUSR1;
- prepare_crash_dump();
+ prepare_crash_dump((int)0);
erl_exit(1, "Received SIGUSR1\n");
}
@@ -1021,15 +1055,6 @@ void fini_getenv_state(GETENV_STATE *state)
#define ERTS_SYS_READ_BUF_SZ (64*1024)
-/* This data is shared by these drivers - initialized by spawn_init() */
-static struct driver_data {
- int port_num, ofd, packet_bytes;
- ErtsSysReportExit *report_exit;
- int pid;
- int alive;
- int status;
-} *driver_data; /* indexed by fd */
-
/* Driver interfaces */
static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*);
static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*);
@@ -2419,6 +2444,15 @@ erts_sys_getenv_raw(char *key, char *value, size_t *size) {
return erts_sys_getenv(key, value, size);
}
+/*
+ * erts_sys_getenv
+ * returns:
+ * -1, if environment key is not set with a value
+ * 0, if environment key is set and value fits into buffer size
+ * 1, if environment key is set but does not fit into buffer size
+ * size is set with the needed buffer size value
+ */
+
int
erts_sys_getenv(char *key, char *value, size_t *size)
{
diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c
index 6c69fecbf3..47d12ed5fe 100755
--- a/erts/emulator/sys/win32/sys.c
+++ b/erts/emulator/sys/win32/sys.c
@@ -256,10 +256,25 @@ void erl_sys_args(int* argc, char** argv)
}
void
-erts_sys_prepare_crash_dump(void)
+erts_sys_prepare_crash_dump(int secs)
{
+ Port *heart_port;
+ Eterm heap[3];
+ Eterm *hp = heap;
+ Eterm list = NIL;
+
+ heart_port = erts_get_heart_port();
+
+ if (heart_port) {
+
+ list = CONS(hp, make_small(8), list); hp += 2;
+
+ /* send to heart port, CMD = 8, i.e. prepare crash dump =o */
+ erts_write_to_port(NIL, heart_port, list);
+ }
+
/* Windows - free file descriptors are hopefully available */
- return;
+ /* Alarm not used on windows */
}
static void
diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c
index 7b78cc489d..81d797dc7e 100644
--- a/erts/etc/common/heart.c
+++ b/erts/etc/common/heart.c
@@ -115,7 +115,8 @@
# endif
#endif
-#define HEART_COMMAND_ENV "HEART_COMMAND"
+#define HEART_COMMAND_ENV "HEART_COMMAND"
+#define ERL_CRASH_DUMP_SECONDS_ENV "ERL_CRASH_DUMP_SECONDS"
#define MSG_HDR_SIZE 2
#define MSG_HDR_PLUS_OP_SIZE 3
@@ -131,13 +132,14 @@ struct msg {
};
/* operations */
-#define HEART_ACK 1
-#define HEART_BEAT 2
-#define SHUT_DOWN 3
-#define SET_CMD 4
-#define CLEAR_CMD 5
-#define GET_CMD 6
-#define HEART_CMD 7
+#define HEART_ACK (1)
+#define HEART_BEAT (2)
+#define SHUT_DOWN (3)
+#define SET_CMD (4)
+#define CLEAR_CMD (5)
+#define GET_CMD (6)
+#define HEART_CMD (7)
+#define PREPARING_CRASH (8)
/* Maybe interesting to change */
@@ -165,10 +167,11 @@ unsigned long heart_beat_kill_pid = 0;
#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay)
/* reasons for reboot */
-#define R_TIMEOUT 1
-#define R_CLOSED 2
-#define R_ERROR 3
-#define R_SHUT_DOWN 4
+#define R_TIMEOUT (1)
+#define R_CLOSED (2)
+#define R_ERROR (3)
+#define R_SHUT_DOWN (4)
+#define R_CRASHING (5) /* Doing a crash dump and we will wait for it */
/* macros */
@@ -178,8 +181,8 @@ unsigned long heart_beat_kill_pid = 0;
/* prototypes */
-static int message_loop(int,int);
-static void do_terminate(int);
+static int message_loop(int, int);
+static void do_terminate(int, int);
static int notify_ack(int);
static int heart_cmd_reply(int, char *);
static int write_message(int, struct msg *);
@@ -190,6 +193,7 @@ static void print_error(const char *,...);
static void debugf(const char *,...);
static void init_timestamp(void);
static time_t timestamp(time_t *);
+static int wait_until_close_write_or_env_tmo(int);
#ifdef __WIN32__
static BOOL enable_privilege(void);
@@ -328,12 +332,14 @@ static void get_arguments(int argc, char** argv) {
debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p);
}
-int
-main(int argc, char **argv)
-{
+int main(int argc, char **argv) {
+
+ if (is_env_set("HEART_DEBUG")) {
+ fprintf(stderr, "heart: debug is ON!\r\n");
+ debug_on = 1;
+ }
+
get_arguments(argc,argv);
- if (is_env_set("HEART_DEBUG"))
- debug_on=1;
#ifdef __WIN32__
if (debug_on) {
if(!is_env_set("ERLSRV_SERVICE_NAME")) {
@@ -354,7 +360,7 @@ main(int argc, char **argv)
program_name[sizeof(program_name)-1] = '\0';
notify_ack(erlout_fd);
cmd[0] = '\0';
- do_terminate(message_loop(erlin_fd,erlout_fd));
+ do_terminate(erlin_fd,message_loop(erlin_fd,erlout_fd));
return 0;
}
@@ -388,6 +394,7 @@ message_loop(erlin_fd, erlout_fd)
#endif
while (1) {
+ /* REFACTOR: below to select/tmo function */
#ifdef __WIN32__
wresult = WaitForSingleObject(hevent_dataready,SELECT_TIMEOUT*1000+ 2);
if (wresult == WAIT_FAILED) {
@@ -482,6 +489,10 @@ message_loop(erlin_fd, erlout_fd)
free_env_val(env);
}
break;
+ case PREPARING_CRASH:
+ /* Erlang has reached a crushdump point (is crashing for sure) */
+ print_error("Erlang is crashing .. (waiting for crash dump file)");
+ return R_CRASHING;
default:
/* ignore all other messages */
break;
@@ -612,72 +623,130 @@ void win_system(char *command)
* do_terminate
*/
static void
-do_terminate(reason)
- int reason;
-{
+do_terminate(int erlin_fd, int reason) {
/*
When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish
(plus heart_beat_report_delay if under VxWorks), so we don't need
to call wd_reset().
*/
-
+ int ret = 0, tmo=0;
+ char *tmo_env;
+
switch (reason) {
case R_SHUT_DOWN:
break;
+ case R_CRASHING:
+ if (is_env_set(ERL_CRASH_DUMP_SECONDS_ENV)) {
+ tmo_env = get_env(ERL_CRASH_DUMP_SECONDS_ENV);
+ tmo = atoi(tmo_env);
+ print_error("Waiting for dump - timeout set to %d seconds.", tmo);
+ wait_until_close_write_or_env_tmo(tmo);
+ free_env_val(tmo_env);
+ }
+ /* fall through */
case R_TIMEOUT:
- case R_ERROR:
case R_CLOSED:
+ case R_ERROR:
default:
-#if defined(__WIN32__)
{
- if(!cmd[0]) {
- char *command = get_env(HEART_COMMAND_ENV);
- if(!command)
- print_error("Would reboot. Terminating.");
- else {
- kill_old_erlang();
- /* High prio combined with system() works badly indeed... */
- SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
- win_system(command);
- print_error("Executed \"%s\". Terminating.",command);
+#if defined(__WIN32__) /* Not VxWorks */
+ if(!cmd[0]) {
+ char *command = get_env(HEART_COMMAND_ENV);
+ if(!command)
+ print_error("Would reboot. Terminating.");
+ else {
+ kill_old_erlang();
+ /* High prio combined with system() works badly indeed... */
+ SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
+ win_system(command);
+ print_error("Executed \"%s\". Terminating.",command);
+ }
+ free_env_val(command);
+ } else {
+ kill_old_erlang();
+ /* High prio combined with system() works badly indeed... */
+ SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
+ win_system(&cmd[0]);
+ print_error("Executed \"%s\". Terminating.",cmd);
}
- free_env_val(command);
- }
- else {
- kill_old_erlang();
- /* High prio combined with system() works badly indeed... */
- SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS);
- win_system(&cmd[0]);
- print_error("Executed \"%s\". Terminating.",cmd);
- }
- }
-
#else
- {
- if(!cmd[0]) {
- char *command = get_env(HEART_COMMAND_ENV);
- if(!command)
- print_error("Would reboot. Terminating.");
- else {
- kill_old_erlang();
- /* suppress gcc warning with 'if' */
- if(system(command));
- print_error("Executed \"%s\". Terminating.",command);
+ if(!cmd[0]) {
+ char *command = get_env(HEART_COMMAND_ENV);
+ if(!command)
+ print_error("Would reboot. Terminating.");
+ else {
+ kill_old_erlang();
+ /* suppress gcc warning with 'if' */
+ ret = system(command);
+ print_error("Executed \"%s\" -> %d. Terminating.",command, ret);
+ }
+ free_env_val(command);
+ } else {
+ kill_old_erlang();
+ /* suppress gcc warning with 'if' */
+ ret = system((char*)&cmd[0]);
+ print_error("Executed \"%s\" -> %d. Terminating.",cmd, ret);
}
- free_env_val(command);
- }
- else {
- kill_old_erlang();
- /* suppress gcc warning with 'if' */
- if(system((char*)&cmd[0]));
- print_error("Executed \"%s\". Terminating.",cmd);
- }
+#endif
}
break;
-#endif
} /* switch(reason) */
}
+
+/* Waits until something happens on socket or handle
+ *
+ * Uses global variables erlin_fd or hevent_dataready
+ */
+int wait_until_close_write_or_env_tmo(int tmo) {
+ int i = 0;
+
+#ifdef __WIN32__
+ DWORD wresult;
+ DWORD wtmo = INFINITE;
+
+ if (tmo >= 0) {
+ wtmo = tmo*1000 + 2;
+ }
+
+ wresult = WaitForSingleObject(hevent_dataready, wtmo);
+ if (wresult == WAIT_FAILED) {
+ print_last_error();
+ return -1;
+ }
+
+ if (wresult == WAIT_TIMEOUT) {
+ debugf("wait timed out\n");
+ i = 0;
+ } else {
+ debugf("wait ok\n");
+ i = 1;
+ }
+#else
+ fd_set read_fds;
+ int max_fd;
+ struct timeval timeout;
+ struct timeval *tptr = NULL;
+
+ max_fd = erlin_fd; /* global */
+
+ if (tmo >= 0) {
+ timeout.tv_sec = tmo; /* On Linux timeout is modified by select */
+ timeout.tv_usec = 0;
+ tptr = &timeout;
+ }
+
+ FD_ZERO(&read_fds);
+ FD_SET(erlin_fd, &read_fds);
+ if ((i = select(max_fd + 1, &read_fds, NULLFDS, NULLFDS, tptr)) < 0) {
+ print_error("error in select.");
+ return -1;
+ }
+#endif
+ return i;
+}
+
+
/*
* notify_ack
*
@@ -868,12 +937,13 @@ debugf(const char *format,...)
{
va_list args;
- if (!debug_on) return;
- va_start(args, format);
- fprintf(stderr, "Heart: ");
- vfprintf(stderr, format, args);
- va_end(args);
- fprintf(stderr, "\r\n");
+ if (debug_on) {
+ va_start(args, format);
+ fprintf(stderr, "Heart: ");
+ vfprintf(stderr, format, args);
+ va_end(args);
+ fprintf(stderr, "\r\n");
+ }
}
#ifdef __WIN32__
diff --git a/lib/kernel/doc/src/heart.xml b/lib/kernel/doc/src/heart.xml
index 26d1e27822..2826d3d00a 100644
--- a/lib/kernel/doc/src/heart.xml
+++ b/lib/kernel/doc/src/heart.xml
@@ -71,6 +71,39 @@
timeout and try to reboot the system. This can happen, for
example, if the system clock is adjusted automatically by use of
NTP (Network Time Protocol).</p>
+
+ <p> If a crash occurs, an <c><![CDATA[erl_crash.dump]]></c> will <em>not</em> be written
+ unless the environment variable <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> is set.
+ </p>
+
+ <pre>
+% <input>erl -heart -env ERL_CRASH_DUMP_SECONDS 10 ...</input></pre>
+ <p>
+ Furthermore, <c><![CDATA[ERL_CRASH_DUMP_SECONDS]]></c> has the following behaviour on
+ <c>heart</c>:
+ </p>
+ <taglist>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=0]]></c></tag>
+ <item><p>
+ Suppresses the writing a crash dump file entirely,
+ thus rebooting the runtime system immediately.
+ This is the same as not setting the environment variable.
+ </p>
+ </item>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=-1]]></c></tag>
+ <item><p> Setting the environment variable to a negative value will not reboot
+ the runtime system until the crash dump file has been completly written.
+ </p>
+ </item>
+ <tag><c><![CDATA[ERL_CRASH_DUMP_SECONDS=S]]></c></tag>
+ <item><p>
+ Heart will wait for <c>S</c> seconds to let the crash dump file be written.
+ After <c>S</c> seconds <c>heart</c> will reboot the runtime system regardless of
+ the crash dump file has been written or not.
+ </p>
+ </item>
+ </taglist>
+
<p>In the following descriptions, all function fails with reason
<c>badarg</c> if <c>heart</c> is not started.</p>
</description>
diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl
index 28452a377e..de287bfa43 100644
--- a/lib/kernel/src/heart.erl
+++ b/lib/kernel/src/heart.erl
@@ -42,6 +42,7 @@
-define(CLEAR_CMD, 5).
-define(GET_CMD, 6).
-define(HEART_CMD, 7).
+-define(PREPARING_CRASH, 8). % Used in beam vm
-define(TIMEOUT, 5000).
-define(CYCLE_TIMEOUT, 10000).
@@ -130,6 +131,8 @@ start_portprogram() ->
Port when is_port(Port) ->
case wait_ack(Port) of
ok ->
+ %% register port so the vm can find it if need be
+ register(heart_port, Port),
{ok, Port};
{error, Reason} ->
report_problem({{port_problem, Reason},
diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl
index 31005a01e2..970a03cfd5 100644
--- a/lib/kernel/test/heart_SUITE.erl
+++ b/lib/kernel/test/heart_SUITE.erl
@@ -22,7 +22,10 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2, start/1, restart/1,
- reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1,
+ reboot/1,
+ node_start_immediately_after_crash/1,
+ node_start_soon_after_crash/1,
+ set_cmd/1, clear_cmd/1, get_cmd/1,
dont_drop/1, kill_pid/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -38,15 +41,15 @@ init_per_testcase(_Func, Config) ->
end_per_testcase(_Func, Config) ->
Nodes = nodes(),
lists:foreach(fun(X) ->
- NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))),
- case NNam of
- heart_test ->
- ?t:format(1, "WARNING: Killed ~p~n", [X]),
- rpc:cast(X, erlang, halt, []);
- _ ->
- ok
- end
- end, Nodes),
+ NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))),
+ case NNam of
+ heart_test ->
+ ?t:format(1, "WARNING: Killed ~p~n", [X]),
+ rpc:cast(X, erlang, halt, []);
+ _ ->
+ ok
+ end
+ end, Nodes),
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog).
@@ -57,8 +60,13 @@ end_per_testcase(_Func, Config) ->
%%-----------------------------------------------------------------
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
- [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid].
+all() -> [
+ start, restart, reboot,
+ node_start_immediately_after_crash,
+ node_start_soon_after_crash,
+ set_cmd, clear_cmd, get_cmd,
+ kill_pid
+ ].
groups() ->
[].
@@ -80,17 +88,22 @@ init_per_suite(Config) when is_list(Config) ->
end_per_suite(Config) when is_list(Config) ->
Config.
+
start_check(Type, Name) ->
+ start_check(Type, Name, []).
+start_check(Type, Name, Envs) ->
Args = case ?t:os_type() of
- {win32,_} -> "-heart -env HEART_COMMAND no_reboot";
- _ -> "-heart"
- end,
+ {win32,_} ->
+ "-heart " ++ env_encode([{"HEART_COMMAND", no_reboot}|Envs]);
+ _ ->
+ "-heart " ++ env_encode(Envs)
+ end,
{ok, Node} = case Type of
- loose ->
- loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS);
- _ ->
- ?t:start_node(Name, Type, [{args, Args}])
- end,
+ loose ->
+ loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS);
+ _ ->
+ ?t:start_node(Name, Type, [{args, Args}])
+ end,
erlang:monitor_node(Node, true),
case rpc:call(Node, erlang, whereis, [heart]) of
Pid when is_pid(Pid) ->
@@ -103,21 +116,19 @@ start_check(Type, Name) ->
start(doc) -> [];
start(suite) -> {req, [{time, 10}]};
start(Config) when is_list(Config) ->
- ?line {ok, Node} = start_check(slave, heart_test),
- ?line rpc:call(Node, init, reboot, []),
+ {ok, Node} = start_check(slave, heart_test),
+ rpc:call(Node, init, reboot, []),
receive
- {nodedown, Node} ->
- ok
- after 2000 ->
- test_server:fail(node_not_closed)
+ {nodedown, Node} -> ok
+ after 2000 -> test_server:fail(node_not_closed)
end,
test_server:sleep(5000),
- ?line case net_adm:ping(Node) of
- pang ->
- ok;
- _ ->
- test_server:fail(node_rebooted)
- end,
+ case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ test_server:fail(node_rebooted)
+ end,
test_server:stop_node(Node).
%% Also test fixed bug in R1B (it was not possible to
@@ -125,6 +136,10 @@ start(Config) when is_list(Config) ->
%% Slave executes erlang:halt() on master nodedown.
%% Therefore the slave process has to be killed
%% before restart.
+
+%% restart
+%% Purpose:
+%% Check that a node is up and running after a init:restart/0
restart(doc) -> [];
restart(suite) ->
case ?t:os_type() of
@@ -134,8 +149,8 @@ restart(suite) ->
{skip, "Only run on unix and win32"}
end;
restart(Config) when is_list(Config) ->
- ?line {ok, Node} = start_check(loose, heart_test),
- ?line rpc:call(Node, init, restart, []),
+ {ok, Node} = start_check(loose, heart_test),
+ rpc:call(Node, init, restart, []),
receive
{nodedown, Node} ->
ok
@@ -143,32 +158,21 @@ restart(Config) when is_list(Config) ->
test_server:fail(node_not_closed)
end,
test_server:sleep(5000),
-
- ?line case net_adm:ping(Node) of
- pong ->
- erlang:monitor_node(Node, true),
- ?line rpc:call(Node, init, stop, []),
- receive
- {nodedown, Node} ->
- ok
- after 2000 ->
- test_server:fail(node_not_closed2)
- end,
- ok;
- _ ->
- test_server:fail(node_not_restarted)
- end,
+ node_check_up_down(Node, 2000),
loose_node:stop(Node).
+%% reboot
+%% Purpose:
+%% Check that a node is up and running after a init:reboot/0
reboot(doc) -> [];
reboot(suite) -> {req, [{time, 10}]};
reboot(Config) when is_list(Config) ->
{ok, Node} = start_check(slave, heart_test),
- ?line ok = rpc:call(Node, heart, set_cmd,
+ ok = rpc:call(Node, heart, set_cmd,
[atom_to_list(lib:progname()) ++
" -noshell -heart " ++ name(Node) ++ "&"]),
- ?line rpc:call(Node, init, reboot, []),
+ rpc:call(Node, init, reboot, []),
receive
{nodedown, Node} ->
ok
@@ -176,44 +180,119 @@ reboot(Config) when is_list(Config) ->
test_server:fail(node_not_closed)
end,
test_server:sleep(5000),
- ?line case net_adm:ping(Node) of
- pong ->
- erlang:monitor_node(Node, true),
- ?line rpc:call(Node, init, reboot, []),
- receive
- {nodedown, Node} ->
- ok
- after 2000 ->
- test_server:fail(node_not_closed2)
- end,
- ok;
- _ ->
- test_server:fail(node_not_rebooted)
- end,
+ node_check_up_down(Node, 2000),
ok.
+%% node_start_immediately_after_crash
+%% Purpose:
+%% Check that a node is up and running after a crash.
+%% This test exhausts the atom table on the remote node.
+%% ERL_CRASH_DUMP_SECONDS=0 will force beam not to dump an erl_crash.dump.
+node_start_immediately_after_crash(suite) -> {req, [{time, 10}]};
+node_start_immediately_after_crash(Config) when is_list(Config) ->
+ {ok, Node} = start_check(loose, heart_test_imm, [{"ERL_CRASH_DUMP_SECONDS", "0"}]),
+
+ ok = rpc:call(Node, heart, set_cmd,
+ [atom_to_list(lib:progname()) ++
+ " -noshell -heart " ++ name(Node) ++ "&"]),
+
+ Mod = exhaust_atoms,
+
+ Code = generate(Mod, [], [
+ "do() -> "
+ " Set = lists:seq($a,$z), "
+ " [ list_to_atom([A,B,C,D,E]) || "
+ " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]."
+ ]),
+
+ %% crash it with atom exhaustion
+ rpc:call(Node, erlang, load_module, [Mod, Code]),
+ rpc:cast(Node, Mod, do, []),
+
+ T0 = now(),
+
+ receive {nodedown, Node} ->
+ test_server:format("Took ~.2f s. for node to go down~n", [timer:now_diff(now(), T0)/1000000]),
+ ok
+ %% timeout is very liberal here. nodedown is received in about 1 s. on linux (palantir)
+ %% and in about 10 s. on solaris (carcharoth)
+ after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(3000),
+ node_check_up_down(Node, 2000),
+ loose_node:stop(Node).
+
+%% node_start_soon_after_crash
+%% Purpose:
+%% Check that a node is up and running after a crash.
+%% This test exhausts the atom table on the remote node.
+%% ERL_CRASH_DUMP_SECONDS=10 will force beam
+%% to only dump an erl_crash.dump for 10 seconds.
+node_start_soon_after_crash(suite) -> {req, [{time, 10}]};
+node_start_soon_after_crash(Config) when is_list(Config) ->
+ {ok, Node} = start_check(loose, heart_test_soon, [{"ERL_CRASH_DUMP_SECONDS", "10"}]),
+
+ ok = rpc:call(Node, heart, set_cmd,
+ [atom_to_list(lib:progname()) ++
+ " -noshell -heart " ++ name(Node) ++ "&"]),
+
+ Mod = exhaust_atoms,
+
+ Code = generate(Mod, [], [
+ "do() -> "
+ " Set = lists:seq($a,$z), "
+ " [ list_to_atom([A,B,C,D,E]) || "
+ " A <- Set, B <- Set, C <- Set, E <- Set, D <- Set ]."
+ ]),
+
+ %% crash it with atom exhaustion
+ rpc:call(Node, erlang, load_module, [Mod, Code]),
+ rpc:cast(Node, Mod, do, []),
+
+ receive {nodedown, Node} -> ok
+ after (15000*test_server:timetrap_scale_factor()) -> test_server:fail(node_not_closed)
+ end,
+ test_server:sleep(20000),
+ node_check_up_down(Node, 15000),
+ loose_node:stop(Node).
+
+
+node_check_up_down(Node, Tmo) ->
+ case net_adm:ping(Node) of
+ pong ->
+ erlang:monitor_node(Node, true),
+ rpc:call(Node, init, reboot, []),
+ receive
+ {nodedown, Node} -> ok
+ after Tmo ->
+ test_server:fail(node_not_closed2)
+ end;
+ _ ->
+ test_server:fail(node_not_rebooted)
+ end.
+
%% Only tests bad command, correct behaviour is tested in reboot/1.
set_cmd(suite) -> [];
set_cmd(Config) when is_list(Config) ->
- ?line {ok, Node} = start_check(slave, heart_test),
+ {ok, Node} = start_check(slave, heart_test),
Cmd = wrong_atom,
- ?line {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]),
+ {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]),
Cmd1 = lists:duplicate(2047, $a),
- ?line {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]),
+ {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]),
Cmd2 = lists:duplicate(28, $a),
- ?line ok = rpc:call(Node, heart, set_cmd, [Cmd2]),
+ ok = rpc:call(Node, heart, set_cmd, [Cmd2]),
Cmd3 = lists:duplicate(2000, $a),
- ?line ok = rpc:call(Node, heart, set_cmd, [Cmd3]),
+ ok = rpc:call(Node, heart, set_cmd, [Cmd3]),
stop_node(Node),
ok.
clear_cmd(suite) -> {req,[{time,15}]};
clear_cmd(Config) when is_list(Config) ->
- ?line {ok, Node} = start_check(slave, heart_test),
- ?line ok = rpc:call(Node, heart, set_cmd,
+ {ok, Node} = start_check(slave, heart_test),
+ ok = rpc:call(Node, heart, set_cmd,
[atom_to_list(lib:progname()) ++
" -noshell -heart " ++ name(Node) ++ "&"]),
- ?line rpc:call(Node, init, reboot, []),
+ rpc:call(Node, init, reboot, []),
receive
{nodedown, Node} ->
ok
@@ -221,16 +300,16 @@ clear_cmd(Config) when is_list(Config) ->
test_server:fail(node_not_closed)
end,
test_server:sleep(5000),
- ?line case net_adm:ping(Node) of
- pong ->
- erlang:monitor_node(Node, true);
- _ ->
- test_server:fail(node_not_rebooted)
- end,
- ?line ok = rpc:call(Node, heart, set_cmd,
+ case net_adm:ping(Node) of
+ pong ->
+ erlang:monitor_node(Node, true);
+ _ ->
+ test_server:fail(node_not_rebooted)
+ end,
+ ok = rpc:call(Node, heart, set_cmd,
["erl -noshell -heart " ++ name(Node) ++ "&"]),
- ?line ok = rpc:call(Node, heart, clear_cmd, []),
- ?line rpc:call(Node, init, reboot, []),
+ ok = rpc:call(Node, heart, clear_cmd, []),
+ rpc:call(Node, init, reboot, []),
receive
{nodedown, Node} ->
ok
@@ -238,20 +317,20 @@ clear_cmd(Config) when is_list(Config) ->
test_server:fail(node_not_closed)
end,
test_server:sleep(5000),
- ?line case net_adm:ping(Node) of
- pang ->
- ok;
- _ ->
- test_server:fail(node_rebooted)
- end,
+ case net_adm:ping(Node) of
+ pang ->
+ ok;
+ _ ->
+ test_server:fail(node_rebooted)
+ end,
ok.
get_cmd(suite) -> [];
get_cmd(Config) when is_list(Config) ->
- ?line {ok, Node} = start_check(slave, heart_test),
+ {ok, Node} = start_check(slave, heart_test),
Cmd = "test",
- ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]),
- ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []),
+ ok = rpc:call(Node, heart, set_cmd, [Cmd]),
+ {ok, Cmd} = rpc:call(Node, heart, get_cmd, []),
stop_node(Node),
ok.
@@ -269,57 +348,53 @@ dont_drop(Config) when is_list(Config) ->
[ok,ok,ok,ok,ok,ok,ok,ok,ok,ok] = do_dont_drop(Config,10),
ok.
-do_dont_drop(_,0) ->
- [];
+do_dont_drop(_,0) -> [];
do_dont_drop(Config,N) ->
%% Name of first slave node
- ?line NN1 = atom_to_list(?MODULE) ++ "slave_1",
+ NN1 = atom_to_list(?MODULE) ++ "slave_1",
%% Name of node started by heart on failure
- ?line NN2 = atom_to_list(?MODULE) ++ "slave_2",
+ NN2 = atom_to_list(?MODULE) ++ "slave_2",
%% Name of node started by heart on success
- ?line NN3 = atom_to_list(?MODULE) ++ "slave_3",
- ?line Host = hd(tl(string:tokens(atom_to_list(node()),"@"))),
+ NN3 = atom_to_list(?MODULE) ++ "slave_3",
+ Host = hd(tl(string:tokens(atom_to_list(node()),"@"))),
%% The initial heart command
- ?line FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host),
+ FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host),
%% Separated the parameters to start_node_run for clarity...
- ?line Name = list_to_atom(NN1),
- ?line Env = [{"HEART_COMMAND", FirstCmd}],
- ?line Func = "start_heart_stress",
- ?line Arg = NN3 ++ "@" ++ Host ++ " " ++
+ Name = list_to_atom(NN1),
+ Env = [{"HEART_COMMAND", FirstCmd}],
+ Func = "start_heart_stress",
+ Arg = NN3 ++ "@" ++ Host ++ " " ++
filename:join(?config(data_dir, Config), "simple_echo"),
- ?line start_node_run(Name,Env,Func,Arg),
- ?line case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host),
- list_to_atom(NN3 ++ "@" ++ Host)) of
- 2 ->
- ?line [ok | do_dont_drop(Config,N-1)];
- _ ->
- ?line false
- end.
+ start_node_run(Name,Env,Func,Arg),
+ case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host),
+ list_to_atom(NN3 ++ "@" ++ Host)) of
+ 2 ->
+ [ok | do_dont_drop(Config,N-1)];
+ _ ->
+ false
+ end.
wait_for_any_of(N1,N2) ->
- ?line wait_for_any_of(N1,N2,45).
+ wait_for_any_of(N1,N2,45).
wait_for_any_of(_N1,_N2,0) ->
- ?line false;
+ false;
wait_for_any_of(N1,N2,Times) ->
- ?line receive
- after 1000 ->
- ?line ok
- end,
- ?line case net_adm:ping(N1) of
- pang ->
- ?line case net_adm:ping(N2) of
- pang ->
- ?line wait_for_any_of(N1,N2,Times - 1);
- pong ->
- ?line rpc:call(N2,init,stop,[]),
- ?line 2
- end;
- pong ->
- ?line rpc:call(N1,init,stop,[]),
- ?line 1
- end.
+ receive after 1000 -> ok end,
+ case net_adm:ping(N1) of
+ pang ->
+ case net_adm:ping(N2) of
+ pang ->
+ wait_for_any_of(N1,N2,Times - 1);
+ pong ->
+ rpc:call(N2,init,stop,[]),
+ 2
+ end;
+ pong ->
+ rpc:call(N1,init,stop,[]),
+ 1
+ end.
kill_pid(suite) ->
@@ -336,9 +411,7 @@ do_kill_pid(_Config) ->
{ok,Node} = start_node_run(Name,Env,suicide_by_heart,[]),
ok = wait_for_node(Node,15),
erlang:monitor_node(Node, true),
- receive
- {nodedown,Node} ->
- ok
+ receive {nodedown,Node} -> ok
after 30000 ->
false
end.
@@ -346,23 +419,16 @@ do_kill_pid(_Config) ->
wait_for_node(_,0) ->
false;
wait_for_node(Node,N) ->
- receive
- after 1000 ->
- ok
- end,
+ receive after 1000 -> ok end,
case net_adm:ping(Node) of
- pong ->
- ok;
- pang ->
- wait_for_node(Node,N-1)
+ pong -> ok;
+ pang -> wait_for_node(Node,N-1)
end.
erl() ->
case os:type() of
- {win32,_} ->
- "werl ";
- _ ->
- "erl "
+ {win32,_} -> "werl ";
+ _ -> "erl "
end.
name(Node) when is_list(Node) -> name(Node,[]);
@@ -379,15 +445,13 @@ name([H|T], Name) ->
name(T, [H|Name]).
-atom_conv(A) when is_atom(A) ->
- atom_to_list(A);
-atom_conv(A) when is_list(A) ->
- A.
+enc(A) when is_atom(A) -> atom_to_list(A);
+enc(A) when is_binary(A) -> binary_to_list(A);
+enc(A) when is_list(A) -> A.
-env_conv([]) ->
- [];
-env_conv([{X,Y}|T]) ->
- atom_conv(X) ++ " \"" ++ atom_conv(Y) ++ "\" " ++ env_conv(T).
+env_encode([]) -> [];
+env_encode([{X,Y}|T]) ->
+ "-env " ++ enc(X) ++ " \"" ++ enc(Y) ++ "\" " ++ env_encode(T).
%%%
%%% Starts a node and runs a function in this
@@ -398,12 +462,12 @@ env_conv([{X,Y}|T]) ->
%%% Argument is the argument(s) to send through erl -s
%%%
start_node_run(Name, Env, Function, Argument) ->
- ?line PA = filename:dirname(code:which(?MODULE)),
- ?line Params = "-heart -env " ++ env_conv(Env) ++ " -pa " ++ PA ++
- " -s " ++
- atom_conv(?MODULE) ++ " " ++ atom_conv(Function) ++ " " ++
- atom_conv(Argument),
- ?line start_node(Name, Params).
+ PA = filename:dirname(code:which(?MODULE)),
+ Params = "-heart " ++ env_encode(Env) ++ " -pa " ++ PA ++
+ " -s " ++
+ enc(?MODULE) ++ " " ++ enc(Function) ++ " " ++
+ enc(Argument),
+ start_node(Name, Params).
start_node(Name, Param) ->
test_server:start_node(Name, slave, [{args, Param}]).
@@ -469,3 +533,24 @@ suicide_by_heart() ->
{makaronipudding} ->
sallad
end.
+
+
+%% generate a module from binary
+generate(Module, Attributes, FunStrings) ->
+ FunForms = function_forms(FunStrings),
+ Forms = [
+ {attribute,1,module,Module},
+ {attribute,2,export,[FA || {FA,_} <- FunForms]}
+ ] ++ [{attribute, 3, A, V}|| {A, V} <- Attributes] ++
+ [ Function || {_, Function} <- FunForms],
+ {ok, Module, Bin} = compile:forms(Forms),
+ Bin.
+
+
+function_forms([]) -> [];
+function_forms([S|Ss]) ->
+ {ok, Ts,_} = erl_scan:string(S),
+ {ok, Form} = erl_parse:parse_form(Ts),
+ Fun = element(3, Form),
+ Arity = element(4, Form),
+ [{{Fun,Arity}, Form}|function_forms(Ss)].
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 16:59:34 +0000