diff options
Diffstat (limited to 'erts')
69 files changed, 3619 insertions, 2259 deletions
diff --git a/erts/configure.in b/erts/configure.in index 77a4d32787..0257079c3b 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -234,8 +234,8 @@ AS_HELP_STRING([--enable-m32-build], ],enable_m32_build=no) AC_ARG_WITH(dynamic-trace, -AS_HELP_STRING([--with-dynamic-trace={dtrace|systemtap}], - [specify use of dynamic trace framework, dtrace or systemtap]) +AS_HELP_STRING([--with-dynamic-trace={dtrace|lttng|systemtap}], + [specify use of dynamic trace framework, dtrace, lttng or systemtap]) AS_HELP_STRING([--without-dynamic-trace], [don't enable any dynamic tracing (default)])) @@ -245,6 +245,10 @@ fi case "$with_dynamic_trace" in no) DYNAMIC_TRACE_FRAMEWORK=;; + lttng) + AC_DEFINE(USE_LTTNG,[1], + [Define if you want to use lttng for dynamic tracing]) + DYNAMIC_TRACE_FRAMEWORK=lttng;; dtrace) AC_DEFINE(USE_DTRACE,[1], [Define if you want to use dtrace for dynamic tracing]) @@ -280,10 +284,12 @@ AS_HELP_STRING([--enable-vm-probes], fi) AC_SUBST(USE_VM_PROBES) -if test X"$use_vm_probes" = X"yes"; then - USE_VM_PROBES=yes - AC_DEFINE(USE_VM_PROBES,[1], - [Define to enable VM dynamic trace probes]) +if test X"$DYNAMIC_TRACE_FRAMEWORK" != X"lttng"; then + if test X"$use_vm_probes" = X"yes"; then + USE_VM_PROBES=yes + AC_DEFINE(USE_VM_PROBES,[1], + [Define to enable VM dynamic trace probes]) + fi fi AC_ARG_WITH(assumed-cache-line-size, @@ -3756,14 +3762,20 @@ dnl LM_FIND_EMU_CC dnl -dnl DTrace +dnl DTrace & LTTNG dnl case $DYNAMIC_TRACE_FRAMEWORK in dtrace|systemtap) AC_CHECK_TOOL(DTRACE, dtrace, none) test "$DTRACE" = "none" && AC_MSG_ERROR([No dtrace utility found.]); + enable_lttng_test=no enable_dtrace_test=yes;; - *) enable_dtrace_test=no;; + lttng) + enable_lttng_test=yes + enable_dtrace_test=no;; + *) + enable_lttng_test=no + enable_dtrace_test=no;; esac AC_SUBST(DTRACE) @@ -3830,6 +3842,37 @@ if test "$enable_dtrace_test" = "yes" ; then fi fi +if test "$enable_lttng_test" = "yes" ; then + AC_CHECK_HEADERS(lttng/tracepoint.h) + AC_CHECK_HEADERS(lttng/tracepoint-event.h) + dnl The macro tracepoint_enabled is not present in older lttng versions + dnl checking for tracepoint_enabled + AC_MSG_CHECKING([for tracepoint_enabled in lttng/tracepoint.h]) + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM( + [#include <lttng/tracepoint.h> + #define TRACEPOINT_PROVIDER com_ericsson_otp + TRACEPOINT_EVENT( + com_ericsson_otp, + dummy, + TP_ARGS(int, my_int), + TP_FIELDS(ctf_integer(int, my_int, my_int))) + #define TRACEPOINT_CREATE_PROBES + #define TRACEPOINT_DEFINE], + [if(tracepoint_enabled(com_ericsson_otp,dummy)) do {} while(0)])], + [AC_MSG_RESULT([yes])], + [AC_MSG_ERROR([no (must be present)])]) + if test "x$ac_cv_header_lttng_tracepoint_h" = "xyes" \ + -a "x$ac_cv_header_lttng_tracepoint_event_h" = "xyes"; then + # No straight forward way to test for liblttng-ust when no public symbol exists, + # just add the lib. + LIBS="$LIBS -llttng-ust -ldl" + else + AC_MSG_ERROR([No LTTng support found.]) + fi +fi + + dnl dnl SSL, SSH and CRYPTO need the OpenSSL libraries dnl diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 12148ad9c7..3a5cfddc30 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -779,6 +779,8 @@ RUN_OBJS = \ $(OBJDIR)/erl_ptab.o $(OBJDIR)/erl_map.o \ $(OBJDIR)/erl_msacc.o +LTTNG_OBJS = $(OBJDIR)/erlang_lttng.o + ifeq ($(TARGET),win32) DRV_OBJS = \ $(OBJDIR)/registry_drv.o \ @@ -885,7 +887,7 @@ ifdef HIPE_ENABLED EXTRA_BASE_OBJS += $(HIPE_OBJS) endif -BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) +BASE_OBJS = $(EMU_OBJS) $(RUN_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) $(LTTNG_OBJS) before_DTrace_OBJS = $(BASE_OBJS) $(DRV_OBJS) diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names index 169b071cd7..2eb63febe7 100644 --- a/erts/emulator/beam/atom.names +++ b/erts/emulator/beam/atom.names @@ -43,7 +43,7 @@ atom false true atom Underscore='_' atom Noname='nonode@nohost' atom EOT='$end_of_table' -atom Cookie='' +atom Empty='' # # Used in the Beam emulator loop. (Smaller literals usually means tighter code.) diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a390422040..d648a2f23c 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3360,48 +3360,18 @@ do { \ goto do_schedule; } - OpCase(raise_ss): { - /* This was not done very well in R10-0; then, we passed the tag in - the first argument and hoped that the existing c_p->ftrace was - still correct. But the ftrace-object already includes the tag - (or rather, the freason). Now, we pass the original ftrace in - the first argument. We also handle atom tags in the first - argument for backwards compatibility. - */ - Eterm raise_val1; - Eterm raise_val2; - GetArg2(0, raise_val1, raise_val2); - c_p->fvalue = raise_val2; - if (c_p->freason == EXC_NULL) { - /* a safety check for the R10-0 case; should not happen */ - c_p->ftrace = NIL; - c_p->freason = EXC_ERROR; - } - /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */ - switch (raise_val1) { - case am_throw: - c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; - break; - case am_error: - c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; - break; - case am_exit: - c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; - break; - default: - {/* R10-1 and later - XXX note: should do sanity check on given trace if it can be - passed from a user! Currently only expecting generated calls. - */ - struct StackTrace *s; - c_p->ftrace = raise_val1; - s = get_trace_from_exc(raise_val1); - if (s == NULL) { - c_p->freason = EXC_ERROR; - } else { - c_p->freason = PRIMARY_EXCEPTION(s->freason); - } - } + OpCase(i_raise): { + Eterm raise_trace = x(2); + Eterm raise_value = x(1); + struct StackTrace *s; + + c_p->fvalue = raise_value; + c_p->ftrace = raise_trace; + s = get_trace_from_exc(raise_trace); + if (s == NULL) { + c_p->freason = EXC_ERROR; + } else { + c_p->freason = PRIMARY_EXCEPTION(s->freason); } goto find_func_info; } @@ -4102,7 +4072,7 @@ do { \ StoreBifResult(1, result); } - OpCase(i_bs_put_utf16_jIs): { + OpCase(bs_put_utf16_jIs): { Eterm arg; GetArg1(2, arg); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16cbdbffea..a98900460e 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2028,42 +2028,47 @@ load_code(LoaderState* stp) ASSERT(arity == last_op->arity); do_transform: - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - + ASSERT(stp->genop != NULL); if (gen_opc[stp->genop->op].transform != -1) { - int need; - tmp_op = stp->genop; - - for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { - if (tmp_op == NULL) { - goto get_next_instr; - } - tmp_op = tmp_op->next; + if (stp->genop->next == NULL) { + /* + * Simple heuristic: Most transformations requires + * at least two instructions, so make sure that + * there are. That will reduce the number of + * TE_SHORT_WINDOWs. + */ + goto get_next_instr; } switch (transform_engine(stp)) { case TE_FAIL: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation found. stp->genop != NULL and + * last_op_next is still valid. Go ahead and load + * the instruction. + */ break; case TE_OK: + /* + * Some transformation was applied. last_op_next is + * no longer valid and stp->genop may be NULL. + * Try to transform again. + */ + if (stp->genop == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } last_op_next = NULL; - last_op = NULL; goto do_transform; case TE_SHORT_WINDOW: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation applied. stp->genop != NULL and + * last_op_next is still valid. Fetch a new instruction + * before trying the transformation again. + */ goto get_next_instr; } } - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - /* * From the collected generic instruction, find the specific * instruction. @@ -2584,7 +2589,10 @@ load_code(LoaderState* stp) { GenOp* next = stp->genop->next; FREE_GENOP(stp, stp->genop); - stp->genop = next; + if ((stp->genop = next) == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } goto do_transform; } } @@ -2728,13 +2736,6 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) } static int -same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) -{ - return Target.type = TAG_f && Label.type == TAG_u && - Target.val == Label.val; -} - -static int is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live) { return Reg.type == TAG_x && Live.type == TAG_u && @@ -4805,31 +4806,25 @@ transform_engine(LoaderState* st) Uint op; int ap; /* Current argument. */ Uint* restart; /* Where to restart if current match fails. */ - GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ - GenOpArg* var = def_vars; - int num_vars = 0; + GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ + GenOpArg* rest_args = NULL; + int num_rest_args = 0; int i; /* General index. */ Uint mask; GenOp* instr; + GenOp* first = st->genop; + GenOp* keep = NULL; Uint* pc; - int rval; static Uint restart_fail[1] = {TOP_fail}; - ASSERT(gen_opc[st->genop->op].transform != -1); - pc = op_transform + gen_opc[st->genop->op].transform; - restart = pc; + ASSERT(gen_opc[first->op].transform != -1); + restart = op_transform + gen_opc[first->op].transform; restart: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - var = def_vars; - } ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - instr = st->genop; - -#define RETURN(r) rval = (r); goto do_return; + instr = first; #ifdef DEBUG restart = NULL; @@ -4847,7 +4842,7 @@ transform_engine(LoaderState* st) * We'll need at least one more instruction to decide whether * this combination matches or not. */ - RETURN(TE_SHORT_WINDOW); + return TE_SHORT_WINDOW; } if (*pc++ != instr->op) goto restart; @@ -5009,19 +5004,9 @@ transform_engine(LoaderState* st) #if defined(TOP_rest_args) case TOP_rest_args: { - int n = *pc++; int formal_arity = gen_opc[instr->op].arity; - int j = formal_arity; - - num_vars = n + (instr->arity - formal_arity); - var = erts_alloc(ERTS_ALC_T_LOADER_TMP, - num_vars * sizeof(GenOpArg)); - for (i = 0; i < n; i++) { - var[i] = def_vars[i]; - } - while (i < num_vars) { - var[i++] = instr->a[j++]; - } + num_rest_args = instr->arity - formal_arity; + rest_args = instr->a + formal_arity; } break; #endif @@ -5030,21 +5015,22 @@ transform_engine(LoaderState* st) break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } + keep = instr; + st->genop = instr; #ifdef DEBUG instr = 0; #endif break; - +#if defined(TOP_keep) + case TOP_keep: + /* Keep the current instruction unchanged. */ + keep = instr; + st->genop = instr; +#ifdef DEBUG + instr = 0; +#endif + break; +#endif #if defined(TOP_call_end) case TOP_call_end: { @@ -5069,22 +5055,19 @@ transform_engine(LoaderState* st) lastp = &((*lastp)->next); } - instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } - *lastp = st->genop; + keep = instr->next; /* The next_instr was optimized away. */ + *lastp = keep; st->genop = new_instr; } - RETURN(TE_OK); + /* FALLTHROUGH */ #endif + case TOP_end: + while (first != keep) { + GenOp* next = first->next; + FREE_GENOP(st, first); + first = next; + } + return TE_OK; case TOP_new_instr: /* * Note that the instructions are generated in reverse order. @@ -5096,6 +5079,12 @@ transform_engine(LoaderState* st) instr->arity = gen_opc[op].arity; ap = 0; break; +#ifdef TOP_rename + case TOP_rename: + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + return TE_OK; +#endif case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -5115,14 +5104,10 @@ transform_engine(LoaderState* st) #if defined(TOP_store_rest_args) case TOP_store_rest_args: { - int n = *pc++; - int num_extra = num_vars - n; - - ASSERT(n <= num_vars); - GENOP_ARITY(instr, instr->arity+num_extra); + GENOP_ARITY(instr, instr->arity+num_rest_args); memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); - memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg)); - ap += num_extra; + memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); + ap += num_rest_args; } break; #endif @@ -5134,21 +5119,12 @@ transform_engine(LoaderState* st) case TOP_try_me_else_fail: restart = restart_fail; break; - case TOP_end: - RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL); + return TE_FAIL; default: ASSERT(0); } } -#undef RETURN - - do_return: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - } - return rval; } static void diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 22ab71c868..68f4b96893 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -33,7 +33,6 @@ typedef struct gen_op_entry { int specific; int num_specific; int transform; - int min_window; } GenOpEntry; extern GenOpEntry gen_opc[]; diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index fa385f105d..3a6da373c3 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -906,9 +906,9 @@ erts_dsig_send_msg(Eterm remote, Eterm message, ErtsSendContext* ctx) if (token != NIL) ctl = TUPLE4(&ctx->ctl_heap[0], - make_small(DOP_SEND_TT), am_Cookie, remote, token); + make_small(DOP_SEND_TT), am_Empty, remote, token); else - ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); + ctl = TUPLE3(&ctx->ctl_heap[0], make_small(DOP_SEND), am_Empty, remote); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, @@ -963,10 +963,10 @@ erts_dsig_send_reg_msg(Eterm remote_name, Eterm message, if (token != NIL) ctl = TUPLE5(&ctx->ctl_heap[0], make_small(DOP_REG_SEND_TT), - sender->common.id, am_Cookie, remote_name, token); + sender->common.id, am_Empty, remote_name, token); else ctl = TUPLE4(&ctx->ctl_heap[0], make_small(DOP_REG_SEND), - sender->common.id, am_Cookie, remote_name); + sender->common.id, am_Empty, remote_name); DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); DTRACE7(message_send_remote, sender_name, node_name, receiver_name, diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h index fb777d9ac1..e3ff6ebad1 100644 --- a/erts/emulator/beam/dist.h +++ b/erts/emulator/beam/dist.h @@ -43,6 +43,7 @@ #define DFLAG_INTERNAL_TAGS 0x8000 #define DFLAG_UTF8_ATOMS 0x10000 #define DFLAG_MAP_TAG 0x20000 +#define DFLAG_BIG_CREATION 0x40000 /* All flags that should be enabled when term_to_binary/1 is used. */ #define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ @@ -51,7 +52,8 @@ | DFLAG_EXTENDED_PIDS_PORTS \ | DFLAG_EXPORT_PTR_TAG \ | DFLAG_BIT_BINARIES \ - | DFLAG_MAP_TAG) + | DFLAG_MAP_TAG \ + | DFLAG_BIG_CREATION) /* opcodes used in distribution messages */ #define DOP_LINK 1 diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 71e4713624..ee2013bd93 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -235,9 +235,9 @@ void *erts_alloc(ErtsAlcType_t type, Uint size) void *res; ERTS_MSACC_PUSH_AND_SET_STATE_X(ERTS_MSACC_STATE_ALLOC); res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( - ERTS_ALC_T2N(type), - erts_allctrs[ERTS_ALC_T2A(type)].extra, - size); + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + size); if (!res) erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); ERTS_MSACC_POP_STATE_X(); @@ -564,5 +564,3 @@ NAME##_free(TYPE *p) \ #undef ERTS_ALC_ATTRIBUTES #endif /* #ifndef ERL_ALLOC_H__ */ - - diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 5e7dd7cce8..6e682019ba 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -52,6 +52,7 @@ #ifdef ERTS_ENABLE_LOCK_COUNT #include "erl_lock_count.h" #endif +#include "lttng-wrapper.h" #if defined(ERTS_ALLOC_UTIL_HARD_DEBUG) && defined(__GNUC__) #warning "* * * * * * * * * *" @@ -3125,6 +3126,7 @@ cpool_insert(Allctr_t *allctr, Carrier_t *crr) erts_smp_atomic_set_wb(&crr->allctr, ((erts_aint_t) allctr)|ERTS_CRR_ALCTR_FLG_IN_POOL); + LTTNG3(carrier_pool_put, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, CARRIER_SZ(crr)); } static void @@ -3240,6 +3242,7 @@ cpool_fetch(Allctr_t *allctr, UWord size) first_old_traitor = allctr->cpool.traitor_list.next; cpool_entrance = NULL; + LTTNG3(carrier_pool_get, ERTS_ALC_A2AD(allctr->alloc_no), allctr->ix, (unsigned long)size); /* * Search my own pooled_list, * i.e my abandoned carriers that were in the pool last time I checked. @@ -3925,6 +3928,21 @@ create_carrier(Allctr_t *allctr, Uint umem_sz, UWord flags) } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_create)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_create, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + DEBUG_SAVE_ALIGNMENT(crr); return blk; } @@ -4148,6 +4166,21 @@ destroy_carrier(Allctr_t *allctr, Block_t *blk, Carrier_t **busy_pcrr_pp) allctr->remove_mbc(allctr, crr); } +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(carrier_destroy)) { + lttng_decl_carrier_stats(mbc_stats); + lttng_decl_carrier_stats(sbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->mbcs), mbc_stats); + LTTNG_CARRIER_STATS_TO_LTTNG_STATS(&(allctr->sbcs), sbc_stats); + LTTNG5(carrier_destroy, + ERTS_ALC_A2AD(allctr->alloc_no), + allctr->ix, + crr_sz, + mbc_stats, + sbc_stats); + } +#endif + #ifdef ERTS_SMP schedule_dealloc_carrier(allctr, crr); #else diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index b7d717ed23..afdff1a71e 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -30,6 +30,7 @@ #endif #include "erl_mseg.h" +#include "lttng-wrapper.h" #define ERTS_AU_PREF_ALLOC_BITS 11 #define ERTS_AU_MAX_PREF_ALLOC_INSTANCES (1 << ERTS_AU_PREF_ALLOC_BITS) @@ -417,6 +418,18 @@ typedef struct { } blocks; } CarriersStats_t; +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_CARRIER_STATS_TO_LTTNG_STATS(CSP, LSP) \ + do { \ + (LSP)->carriers.size = (CSP)->curr.norm.mseg.size \ + + (CSP)->curr.norm.sys_alloc.size; \ + (LSP)->carriers.no = (CSP)->curr.norm.mseg.no \ + + (CSP)->curr.norm.sys_alloc.no; \ + (LSP)->blocks.size = (CSP)->blocks.curr.size; \ + (LSP)->blocks.no = (CSP)->blocks.curr.no; \ + } while (0) +#endif + #ifdef ERTS_SMP typedef union ErtsAllctrDDBlock_t_ ErtsAllctrDDBlock_t; diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c index cdeeb5281b..69240f7886 100644 --- a/erts/emulator/beam/erl_async.c +++ b/erts/emulator/beam/erl_async.c @@ -28,6 +28,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_MAX_ASYNC_READY_CALLS_IN_SEQ 20 @@ -281,6 +282,13 @@ static ERTS_INLINE void async_add(ErtsAsync *a, ErtsAsyncQ* q) #endif erts_thr_q_enqueue(&q->thr_q, a); +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_add)) { + lttng_decl_portbuf(port_str); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_add, port_str, -1); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_add)) { DTRACE_CHARBUF(port_str, 16); @@ -317,6 +325,14 @@ static ERTS_INLINE ErtsAsync *async_get(ErtsThrQ_t *q, if (saved_fin_deq) erts_thr_q_append_finalize_dequeue_data(&a->q.fin_deq, &fin_deq); #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(aio_pool_get)) { + lttng_decl_portbuf(port_str); + int length = erts_thr_q_length_dirty(q); + lttng_portid_to_str(a->port, port_str); + LTTNG2(aio_pool_get, port_str, length); + } +#endif #ifdef USE_VM_PROBES if (DTRACE_ENABLED(aio_pool_get)) { DTRACE_CHARBUF(port_str, 16); diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c index f006856b6a..b526eda41d 100644 --- a/erts/emulator/beam/erl_bif_ddll.c +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -48,6 +48,7 @@ #include "erl_version.h" #include "erl_bif_unique.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #ifdef ERTS_SMP #define DDLL_SMP 1 @@ -1619,6 +1620,7 @@ static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name) if (q->finish) { int fpe_was_unmasked = erts_block_fpe(); DTRACE1(driver_finish, q->name); + LTTNG1(driver_finish, q->name); (*(q->finish))(); erts_unblock_fpe(fpe_was_unmasked); } diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index d35bbb80b8..0b2c26a548 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -126,6 +126,9 @@ static char erts_system_version[] = ("Erlang/OTP " ERLANG_OTP_RELEASE #ifdef ERTS_FRMPTR " [frame-pointer]" #endif +#ifdef USE_LTTNG + " [lttng]" +#endif #ifdef USE_DTRACE " [dtrace]" #endif @@ -2748,6 +2751,9 @@ BIF_RETTYPE system_info_1(BIF_ALIST_1) #elif defined(USE_SYSTEMTAP) DECL_AM(systemtap); BIF_RET(AM_systemtap); +#elif defined(USE_LTTNG) + DECL_AM(lttng); + BIF_RET(AM_lttng); #else BIF_RET(am_none); #endif diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c index 88efb2c59f..bc0a55068b 100644 --- a/erts/emulator/beam/erl_message.c +++ b/erts/emulator/beam/erl_message.c @@ -766,17 +766,7 @@ erts_send_message(Process* sender, utag = DT_UTAG(sender); else utag = copy_struct(DT_UTAG(sender), dt_utag_size, &hp, ohp); -#ifdef DTRACE_TAG_HARDDEBUG - erts_fprintf(stderr, - "Dtrace -> (%T) Spreading tag (%T) with " - "message %T!\r\n",sender->common.id, utag, message); -#endif } -#endif - BM_MESSAGE_COPIED(msize); - BM_SWAP_TIMER(copy,send); - -#ifdef USE_VM_PROBES if (DTRACE_ENABLED(message_send)) { if (have_seqtrace(stoken)) { tok_label = signed_val(SEQ_TRACE_T_LABEL(stoken)); @@ -787,6 +777,9 @@ erts_send_message(Process* sender, msize, tok_label, tok_lastcnt, tok_serial); } #endif + BM_MESSAGE_COPIED(msize); + BM_SWAP_TIMER(copy,send); + } else { Eterm *hp; @@ -822,8 +815,10 @@ erts_send_message(Process* sender, BM_MESSAGE_COPIED(msz); BM_SWAP_TIMER(copy,send); } +#ifdef USE_VM_PROBES DTRACE6(message_send, sender_name, receiver_name, msize, tok_label, tok_lastcnt, tok_serial); +#endif } res = queue_message(sender, diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c index 8617f42d7b..79da705e0f 100644 --- a/erts/emulator/beam/erl_node_tables.c +++ b/erts/emulator/beam/erl_node_tables.c @@ -497,31 +497,7 @@ node_table_hash(void *venp) Uint32 cre = ((ErlNode *) venp)->creation; HashValue h = atom_tab(atom_val(((ErlNode *) venp)->sysname))->slot.bucket.hvalue; - h *= PRIME0; - h += cre & 0xff; - -#if MAX_CREATION >= (1 << 8) - h *= PRIME1; - h += (cre >> 8) & 0xff; -#endif - -#if MAX_CREATION >= (1 << 16) - h *= PRIME2; - h += (cre >> 16) & 0xff; -#endif - -#if MAX_CREATION >= (1 << 24) - h *= PRIME3; - h += (cre >> 24) & 0xff; -#endif - -#if 0 -/* XXX Problems in older versions of GCC */ - #if MAX_CREATION >= (1UL << 32) - #error "MAX_CREATION larger than size of expected creation storage (Uint32)" - #endif -#endif - return h; + return (h + cre) * PRIME0; } static int @@ -599,7 +575,7 @@ erts_node_table_info(int to, void *to_arg) } -ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation) +ErlNode *erts_find_or_insert_node(Eterm sysname, Uint32 creation) { ErlNode *res; ErlNode ne; diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h index fb2f2a5407..2b93f1f08a 100644 --- a/erts/emulator/beam/erl_node_tables.h +++ b/erts/emulator/beam/erl_node_tables.h @@ -182,7 +182,7 @@ Uint erts_dist_table_size(void); void erts_dist_table_info(int, void *); void erts_set_dist_entry_not_connected(DistEntry *); void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); -ErlNode *erts_find_or_insert_node(Eterm, Uint); +ErlNode *erts_find_or_insert_node(Eterm, Uint32); void erts_schedule_delete_node(ErlNode *); void erts_set_this_node(Eterm, Uint); Uint erts_node_table_size(void); diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c index b200344af5..ec07d145ab 100644 --- a/erts/emulator/beam/erl_port_task.c +++ b/erts/emulator/beam/erl_port_task.c @@ -35,6 +35,7 @@ #include "dist.h" #include "erl_check_io.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include <stdarg.h> /* @@ -69,6 +70,18 @@ static void chk_task_queues(Port *pp, ErtsPortTask *execq, int processing_busy_q #else #define DTRACE_DRIVER(PROBE_NAME, PP) do {} while(0) #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS +#define LTTNG_DRIVER(TRACEPOINT, PP) \ + if (LTTNG_ENABLED(TRACEPOINT)) { \ + lttng_decl_portbuf(port_str); \ + lttng_decl_procbuf(proc_str); \ + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(PP), proc_str); \ + lttng_port_to_str((PP), port_str); \ + LTTNG3(TRACEPOINT, proc_str, port_str, (PP)->name); \ + } +#else +#define LTTNG_DRIVER(TRACEPOINT, PP) do {} while(0) +#endif #define ERTS_SMP_LC_VERIFY_RQ(RQ, PP) \ do { \ @@ -1752,6 +1765,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_TIMEOUT; if (!(state & ERTS_PORT_SFLGS_DEAD)) { DTRACE_DRIVER(driver_timeout, pp); + LTTNG_DRIVER(driver_timeout, pp); (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); } } @@ -1760,6 +1774,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_INPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_input, pp); + LTTNG_DRIVER(driver_ready_input, pp); /* NOTE some windows drivers use ->ready_input for input and output */ (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, @@ -1771,6 +1786,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_OUTPUT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_ready_output, pp); + LTTNG_DRIVER(driver_ready_output, pp); (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event); reset_executed_io_task_handle(ptp); @@ -1780,6 +1796,7 @@ erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) reds = ERTS_PORT_REDS_EVENT; ASSERT((state & ERTS_PORT_SFLGS_DEAD) == 0); DTRACE_DRIVER(driver_event, pp); + LTTNG_DRIVER(driver_event, pp); (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, ptp->u.alive.td.io.event, ptp->u.alive.td.io.event_data); diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index 794af60b2f..57a7b0f288 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -43,6 +43,7 @@ #include "erl_thr_queue.h" #include "erl_async.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_ptab.h" #include "erl_bif_unique.h" #define ERTS_WANT_TIMER_WHEEL_API @@ -3217,6 +3218,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); ASSERT(!erts_port_task_have_outstanding_io_tasks()); + LTTNG2(scheduler_poll, esdp->no, 1); erl_sys_schedule(1); /* Might give us something to do */ ERTS_MSACC_POP_STATE_M(); @@ -3340,6 +3342,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq) ASSERT(!erts_port_task_have_outstanding_io_tasks()); ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 0); erl_sys_schedule(0); @@ -9558,7 +9561,10 @@ Process *schedule(Process *p, int calls) erts_sys_schedule_interrupt(0); #endif erts_smp_runq_unlock(rq); - ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO); + LTTNG2(scheduler_poll, esdp->no, 1); + erl_sys_schedule(1); ERTS_MSACC_POP_STATE_M(); diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h index 0a71534790..fc58853b5e 100644 --- a/erts/emulator/beam/erl_term.h +++ b/erts/emulator/beam/erl_term.h @@ -558,14 +558,6 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) #define _GETBITS(X,Pos,Size) (((X) >> (Pos)) & ~(~((Uint) 0) << (Size))) -/* - * Creation in node specific data (pids, ports, refs) - */ - -#define _CRE_SIZE 2 - -/* MAX value for the creation field in pid, port and reference */ -#define MAX_CREATION (1 << _CRE_SIZE) /* * PID layout (internal pids): @@ -579,7 +571,7 @@ _ET_DECLARE_CHECKED(Eterm*,tuple_val,Wterm) * * n : number * - * Old pid layout: + * Very old pid layout: * * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| diff --git a/erts/emulator/beam/erl_thr_queue.c b/erts/emulator/beam/erl_thr_queue.c index 7ff456b915..30c9d70c59 100644 --- a/erts/emulator/beam/erl_thr_queue.c +++ b/erts/emulator/beam/erl_thr_queue.c @@ -780,3 +780,35 @@ erts_thr_q_dequeue(ErtsThrQ_t *q) return res; #endif } + +#ifdef USE_LTTNG_VM_TRACEPOINTS +int +erts_thr_q_length_dirty(ErtsThrQ_t *q) +{ + int n = 0; +#ifndef USE_THREADS + void *res; + ErtsThrQElement_t *tmp; + + for (tmp = q->first; tmp != NULL; tmp = tmp->next) { + n++; + } +#else + ErtsThrQElement_t *e; + erts_aint_t inext; + + e = ErtsThrQDirtyReadEl(&q->head.head); + inext = erts_atomic_read_acqb(&e->next); + + while (inext != ERTS_AINT_NULL) { + e = (ErtsThrQElement_t *) inext; + if (e != &q->tail.data.marker) { + /* don't count marker */ + n++; + } + inext = erts_atomic_read_acqb(&e->next); + } +#endif + return n; +} +#endif diff --git a/erts/emulator/beam/erl_thr_queue.h b/erts/emulator/beam/erl_thr_queue.h index 27a6d03224..f5e5522948 100644 --- a/erts/emulator/beam/erl_thr_queue.h +++ b/erts/emulator/beam/erl_thr_queue.h @@ -190,6 +190,10 @@ void erts_thr_q_append_finalize_dequeue_data(ErtsThrQFinDeQ_t *, int erts_thr_q_finalize_dequeue(ErtsThrQFinDeQ_t *); void erts_thr_q_finalize_dequeue_state_init(ErtsThrQFinDeQ_t *); +#ifdef USE_LTTNG_VM_TRACEPOINTS +int erts_thr_q_length_dirty(ErtsThrQ_t *); +#endif + #ifdef ERTS_SMP ERTS_GLB_INLINE ErtsThrPrgrVal erts_thr_q_need_thr_progress(ErtsThrQ_t *q); #endif diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h index 98f27a1725..357094633e 100644 --- a/erts/emulator/beam/erl_vm.h +++ b/erts/emulator/beam/erl_vm.h @@ -165,7 +165,6 @@ extern int erts_atom_table_size;/* Atom table size */ extern int erts_pd_initial_size;/* Initial Process dictionary table size */ #define ORIG_CREATION 0 -#define INTERNAL_CREATION 255 /* macros for extracting bytes from uint16's */ diff --git a/erts/emulator/beam/erlang_lttng.c b/erts/emulator/beam/erlang_lttng.c new file mode 100644 index 0000000000..fce40eedc1 --- /dev/null +++ b/erts/emulator/beam/erlang_lttng.c @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. 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% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef USE_LTTNG +#define TRACEPOINT_CREATE_PROBES +/* + * The header containing our TRACEPOINT_EVENTs. + */ +#define TRACEPOINT_DEFINE +#include "erlang_lttng.h" +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/erlang_lttng.h b/erts/emulator/beam/erlang_lttng.h new file mode 100644 index 0000000000..43ceeda671 --- /dev/null +++ b/erts/emulator/beam/erlang_lttng.h @@ -0,0 +1,424 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. 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% + */ + +#ifdef USE_LTTNG +#undef TRACEPOINT_PROVIDER +#define TRACEPOINT_PROVIDER com_ericsson_otp + +#undef TRACEPOINT_INCLUDE +#define TRACEPOINT_INCLUDE "erlang_lttng.h" + +#if !defined(__ERLANG_LTTNG_H__) || defined(TRACEPOINT_HEADER_MULTI_READ) +#define __ERLANG_LTTNG_H__ + +#include <lttng/tracepoint.h> + +/* Schedulers */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + scheduler_poll, + TP_ARGS( + int, id, + int, runnable + ), + TP_FIELDS( + ctf_integer(int, scheduler, id) + ctf_integer(int, runnable, runnable) + ) +) + +#ifndef LTTNG_CARRIER_STATS +#define LTTNG_CARRIER_STATS +typedef struct { + unsigned long no; + unsigned long size; +} lttng_stat_values_t; + +typedef struct { + lttng_stat_values_t carriers; + lttng_stat_values_t blocks; +} lttng_carrier_stats_t; +#endif + + +/* Port and Driver Scheduling */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_start, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_init, + TP_ARGS( + char*, driver, + int, major, + int, minor, + int, flags + ), + TP_FIELDS( + ctf_string(driver, driver) + ctf_integer(int, major, major) + ctf_integer(int, minor, minor) + ctf_integer(int, flags, flags) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_outputv, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_input, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_output, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_event, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_timeout, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop_select, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_flush, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_stop, + TP_ARGS( + char*, pid, + char*, driver, + char*, port + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(driver, driver) + ctf_string(port, port) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_process_exit, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_ready_async, + TP_ARGS( + char*, pid, + char*, port, + char*, driver + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_finish, + TP_ARGS( + char*, driver + ), + TP_FIELDS( + ctf_string(driver, driver) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_call, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + driver_control, + TP_ARGS( + char*, pid, + char*, port, + char*, driver, + unsigned int, command, + size_t, bytes + ), + TP_FIELDS( + ctf_string(pid, pid) + ctf_string(port, port) + ctf_string(driver, driver) + ctf_integer(unsigned int, command, command) + ctf_integer(size_t, bytes, bytes) + ) +) + +/* Async pool */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_get, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + aio_pool_add, + TP_ARGS( + char*, port, + int, length + ), + TP_FIELDS( + ctf_string(port, port) + ctf_integer(int, length, length) + ) +) + + +/* Memory Allocator */ + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_create, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_destroy, + TP_ARGS( + const char*, type, + int, instance, + unsigned long, size, + lttng_carrier_stats_t *, mbcs, + lttng_carrier_stats_t *, sbcs + ), + TP_FIELDS( + ctf_string(type, type) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ctf_integer(unsigned long, mbc_carriers, mbcs->carriers.no) + ctf_integer(unsigned long, mbc_carriers_size, mbcs->carriers.size) + ctf_integer(unsigned long, mbc_blocks, mbcs->blocks.no) + ctf_integer(unsigned long, mbc_blocks_size, mbcs->blocks.size) + ctf_integer(unsigned long, sbc_carriers, sbcs->carriers.no) + ctf_integer(unsigned long, sbc_carriers_size, sbcs->carriers.size) + ctf_integer(unsigned long, sbc_blocks, sbcs->blocks.no) + ctf_integer(unsigned long, sbc_blocks_size, sbcs->blocks.size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_put, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +TRACEPOINT_EVENT( + com_ericsson_otp, + carrier_pool_get, + TP_ARGS( + const char*, name, + int, instance, + unsigned long, size + ), + TP_FIELDS( + ctf_string(type, name) + ctf_integer(int, instance, instance) + ctf_integer(unsigned long, size, size) + ) +) + +#endif /* __ERLANG_LTTNG_H__ */ +#include <lttng/tracepoint-event.h> +#endif /* USE_LTTNG */ diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c index 10f03636ec..5ea155f83f 100644 --- a/erts/emulator/beam/external.c +++ b/erts/emulator/beam/external.c @@ -51,7 +51,18 @@ #define MAX_STRING_LEN 0xffff -#define is_valid_creation(Cre) ((unsigned)(Cre) < MAX_CREATION || (Cre) == INTERNAL_CREATION) +/* MAX value for the creation field in pid, port and reference + for the local node and for the current external format. + + Larger creation values than this are allowed in external pid, port and refs + encoded with NEW_PID_EXT, NEW_PORT_EXT and NEWER_REFERENCE_EXT. + The point here is to prepare for future upgrade to 32-bit creation. + OTP-19 (erts-8.0) can handle big creation values from other (newer) nodes, + but do not use big creation values for the local node yet, + as we still may have to communicate with older nodes. +*/ +#define ERTS_MAX_LOCAL_CREATION (3) +#define is_valid_creation(Cre) ((unsigned)(Cre) <= ERTS_MAX_LOCAL_CREATION) #undef ERTS_DEBUG_USE_DIST_SEP #ifdef DEBUG @@ -97,7 +108,7 @@ static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); struct B2TContext_t; static byte* dec_term(ErtsDistExternal*, ErtsHeapFactory*, byte*, Eterm*, struct B2TContext_t*); static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); -static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*); +static byte* dec_pid(ErtsDistExternal *, ErtsHeapFactory*, byte*, Eterm*, byte tag); static Sint decoded_size(byte *ep, byte* endp, int internal_tags, struct B2TContext_t*); static BIF_RETTYPE term_to_binary_trap_1(BIF_ALIST_1); @@ -2152,12 +2163,13 @@ static byte* enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) { Uint on, os; + Eterm sysname = ((is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) + ? am_Empty : pid_node_name(pid)); + Uint32 creation = pid_creation(pid); + byte* tagp = ep++; - *ep++ = PID_EXT; /* insert atom here containing host and sysname */ - ep = enc_atom(acmp, pid_node_name(pid), ep, dflags); - - /* two bytes for each number and serial */ + ep = enc_atom(acmp, sysname, ep, dflags); on = pid_number(pid); os = pid_serial(pid); @@ -2166,8 +2178,15 @@ enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) ep += 4; put_int32(os, ep); ep += 4; - *ep++ = (is_internal_pid(pid) && (dflags & DFLAG_INTERNAL_TAGS)) ? - INTERNAL_CREATION : pid_creation(pid); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PID_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_pid(pid)); + *tagp = NEW_PID_EXT; + put_int32(creation, ep); + ep += 4; + } return ep; } @@ -2247,27 +2266,27 @@ dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) return ep; } -static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint creation) +static ERTS_INLINE ErlNode* dec_get_node(Eterm sysname, Uint32 creation) { - switch (creation) { - case INTERNAL_CREATION: + if (sysname == am_Empty) /* && DFLAG_INTERNAL_TAGS */ return erts_this_node; - case ORIG_CREATION: - if (sysname == erts_this_node->sysname) { - creation = erts_this_node->creation; - } - } + + if (sysname == erts_this_node->sysname + && (creation == erts_this_node->creation || creation == ORIG_CREATION)) + return erts_this_node; + return erts_find_or_insert_node(sysname,creation); } static byte* -dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, Eterm* objp) +dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, + Eterm* objp, byte tag) { Eterm sysname; Uint data; Uint num; Uint ser; - Uint cre; + Uint32 cre; ErlNode *node; *objp = NIL; /* In case we fail, don't leave a hole in the heap */ @@ -2283,12 +2302,19 @@ dec_pid(ErtsDistExternal *edep, ErtsHeapFactory* factory, byte* ep, Eterm* objp) ep += 4; if (ser > ERTS_MAX_PID_SERIAL) return NULL; - cre = get_int8(ep); - ep += 1; - if (!is_valid_creation(cre)) { - return NULL; + if (tag == PID_EXT) { + cre = get_int8(ep); + ep += 1; + if (!is_valid_creation(cre)) { + return NULL; + } + } else { + ASSERT(tag == NEW_PID_EXT); + cre = get_int32(ep); + ep += 4; } + data = make_pid_data(ser, num); /* @@ -2528,16 +2554,26 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, case REF_DEF: case EXTERNAL_REF_DEF: { Uint32 *ref_num; + Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) + ? am_Empty : ref_node_name(obj)); + Uint32 creation = ref_creation(obj); + byte* tagp = ep++; ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); - *ep++ = NEW_REFERENCE_EXT; i = ref_no_of_numbers(obj); put_int16(i, ep); ep += 2; - ep = enc_atom(acmp,ref_node_name(obj),ep,dflags); - *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_ref(obj)) ? - INTERNAL_CREATION : ref_creation(obj); + ep = enc_atom(acmp, sysname, ep, dflags); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = NEW_REFERENCE_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_ref(obj)); + *tagp = NEWER_REFERENCE_EXT; + put_int32(creation, ep); + ep += 4; + } ref_num = ref_numbers(obj); for (j = 0; j < i; j++) { put_int32(ref_num[j], ep); @@ -2546,17 +2582,27 @@ enc_term_int(TTBEncodeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, break; } case PORT_DEF: - case EXTERNAL_PORT_DEF: + case EXTERNAL_PORT_DEF: { + Eterm sysname = (((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) + ? am_Empty : port_node_name(obj)); + Uint32 creation = port_creation(obj); + byte* tagp = ep++; - *ep++ = PORT_EXT; - ep = enc_atom(acmp,port_node_name(obj),ep,dflags); + ep = enc_atom(acmp, sysname, ep, dflags); j = port_number(obj); put_int32(j, ep); ep += 4; - *ep++ = ((dflags & DFLAG_INTERNAL_TAGS) && is_internal_port(obj)) ? - INTERNAL_CREATION : port_creation(obj); + if (creation <= ERTS_MAX_LOCAL_CREATION) { + *tagp = PORT_EXT; + *ep++ = creation; + } else { + ASSERT(is_external_port(obj)); + *tagp = NEW_PORT_EXT; + put_int32(creation, ep); + ep += 4; + } break; - + } case LIST_DEF: { int is_str; @@ -3260,20 +3306,23 @@ dec_term_atom_common: hp += FLOAT_SIZE_OBJECT; break; } - case PID_EXT: + case PID_EXT: + case NEW_PID_EXT: factory->hp = hp; - ep = dec_pid(edep, factory, ep, objp); + ep = dec_pid(edep, factory, ep, objp, ep[-1]); hp = factory->hp; if (ep == NULL) { goto error; } break; - case PORT_EXT: + case PORT_EXT: + case NEW_PORT_EXT: { Eterm sysname; ErlNode *node; Uint num; - Uint cre; + Uint32 cre; + byte tag = ep[-1]; if ((ep = dec_atom(edep, ep, &sysname)) == NULL) { goto error; @@ -3282,12 +3331,17 @@ dec_term_atom_common: goto error; } ep += 4; - cre = get_int8(ep); - ep++; - if (!is_valid_creation(cre)) { - goto error; - } - + if (tag == PORT_EXT) { + cre = get_int8(ep); + ep++; + if (!is_valid_creation(cre)) { + goto error; + } + } + else { + cre = get_int32(ep); + ep += 4; + } node = dec_get_node(sysname, cre); if(node == erts_this_node) { *objp = make_internal_port(num); @@ -3312,7 +3366,7 @@ dec_term_atom_common: Eterm sysname; ErlNode *node; int i; - Uint cre; + Uint32 cre; Uint32 *ref_num; Uint32 r0; Uint ref_words; @@ -3336,9 +3390,6 @@ dec_term_atom_common: ref_words = get_int16(ep); ep += 2; - if (ref_words > ERTS_MAX_REF_NUMBERS) - goto error; - if ((ep = dec_atom(edep, ep, &sysname)) == NULL) goto error; @@ -3351,8 +3402,23 @@ dec_term_atom_common: ep += 4; if (r0 >= MAX_REFERENCE) goto error; + goto ref_ext_common; + + case NEWER_REFERENCE_EXT: + ref_words = get_int16(ep); + ep += 2; + + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) + goto error; + + cre = get_int32(ep); + ep += 4; + r0 = get_int32(ep); /* allow full word */ + ep += 4; ref_ext_common: + if (ref_words > ERTS_MAX_REF_NUMBERS) + goto error; node = dec_get_node(sysname, cre); if(node == erts_this_node) { @@ -3706,9 +3772,9 @@ dec_term_atom_common: *objp = make_fun(funp); /* Creator pid */ - if (*ep != PID_EXT - || (ep = dec_pid(edep, factory, ++ep, - &funp->creator))==NULL) { + if ((*ep != PID_EXT && *ep != NEW_PID_EXT) + || (ep = dec_pid(edep, factory, ep+1, + &funp->creator, *ep))==NULL) { goto error; } @@ -4010,20 +4076,29 @@ encode_size_struct_int(TTBSizeContext* ctx, ErtsAtomCacheMap *acmp, Eterm obj, else result += 1 + 4 + 1 + i; /* tag,size,sign,digits */ break; + case EXTERNAL_PID_DEF: + if (external_pid_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case PID_DEF: - case EXTERNAL_PID_DEF: result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) + 4 + 4 + 1); break; + case EXTERNAL_REF_DEF: + if (external_ref_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ case REF_DEF: - case EXTERNAL_REF_DEF: ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); i = ref_no_of_numbers(obj); result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + 1 + 4*i); break; - case PORT_DEF: - case EXTERNAL_PORT_DEF: + case EXTERNAL_PORT_DEF: + if (external_port_creation(obj) > ERTS_MAX_LOCAL_CREATION) + result += 3; + /*fall through*/ + case PORT_DEF: result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + 4 + 1); break; @@ -4350,19 +4425,22 @@ init_done: SKIP(1+atom_extra_skip); atom_extra_skip = 0; break; - case PID_EXT: + case PID_EXT: + case NEW_PID_EXT: atom_extra_skip = 9; /* In case it is an external pid */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case PORT_EXT: + case PORT_EXT: + case NEW_PORT_EXT: atom_extra_skip = 5; /* In case it is an external port */ heap_size += EXTERNAL_THING_HEAD_SIZE + 1; terms++; break; - case NEW_REFERENCE_EXT: + case NEW_REFERENCE_EXT: + case NEWER_REFERENCE_EXT: { int id_words; diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h index 87eff2fe9f..49198fb47f 100644 --- a/erts/emulator/beam/external.h +++ b/erts/emulator/beam/external.h @@ -18,8 +18,6 @@ * %CopyrightEnd% */ -/* Same order as the ordering of terms in erlang */ - /* Since there are 255 different External tag values to choose from There is no reason to not be extravagant. Hence, the different tags for large/small tuple e.t.c @@ -37,9 +35,12 @@ #define SMALL_ATOM_EXT 's' #define REFERENCE_EXT 'e' #define NEW_REFERENCE_EXT 'r' +#define NEWER_REFERENCE_EXT 'Z' #define PORT_EXT 'f' +#define NEW_PORT_EXT 'Y' #define NEW_FLOAT_EXT 'F' #define PID_EXT 'g' +#define NEW_PID_EXT 'X' #define SMALL_TUPLE_EXT 'h' #define LARGE_TUPLE_EXT 'i' #define NIL_EXT 'j' diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index 29f28cc9dc..b85b581cdc 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -47,6 +47,7 @@ #define ERTS_WANT_EXTERNAL_TAGS #include "external.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #include "erl_map.h" #include "erl_bif_unique.h" #include "erl_hl_timer.h" @@ -717,7 +718,19 @@ erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ DTRACE3(driver_start, process_str, driver->name, port_str); } #endif + ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); + +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_start)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(pid, proc_str); + lttng_port_to_str(port, port_str); + LTTNG3(driver_start, proc_str, driver->name, port_str); + } +#endif + fpe_was_unmasked = erts_block_fpe(); drv_data = (*driver->start)(ERTS_Port2ErlDrvPort(port), name, opts); if (((SWord) drv_data) == -1) @@ -1735,6 +1748,15 @@ call_driver_outputv(int bang_op, DTRACE4(driver_outputv, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_outputv)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_outputv, proc_str, port_str, prt->name, size); + } +#endif prt->caller = caller; (*drv->outputv)((ErlDrvData) prt->drv_data, evp); @@ -1836,6 +1858,15 @@ call_driver_output(int bang_op, DTRACE4(driver_output, process_str, port_str, prt->name, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_output)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG4(driver_output, proc_str, port_str, prt->name, size); + } +#endif prt->caller = caller; (*drv->output)((ErlDrvData) prt->drv_data, bufp, size); @@ -2141,7 +2172,6 @@ erts_port_output(Process *c_p, DTRACE4(port_command, process_str, port_str, prt->name, "command"); } #endif - if (drv->outputv) { ErlIOVec ev; SysIOVec iv[SMALL_WRITE_VEC]; @@ -3697,6 +3727,17 @@ static void flush_port(Port *p) DTRACE3(driver_flush, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_flush)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_flush, proc_str, port_str, p->name); + } +#endif + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { trace_sched_ports_where(p, am_in, am_flush); } @@ -3760,6 +3801,16 @@ terminate_port(Port *prt) DTRACE3(driver_stop, process_str, drv->name, port_str); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_stop)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(connected_id, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_stop, proc_str, drv->name, port_str); + } +#endif + (*drv->stop)((ErlDrvData)prt->drv_data); erts_unblock_fpe(fpe_was_unmasked); ERTS_MSACC_POP_STATE_M(); @@ -4091,6 +4142,16 @@ call_driver_control(Eterm caller, ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_control)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller, proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_control, proc_str, port_str, prt->name, command, size); + } +#endif + prt->caller = caller; cres = prt->drv_ptr->control((ErlDrvData) prt->drv_data, command, @@ -4504,6 +4565,15 @@ call_driver_call(Eterm caller, DTRACE5(driver_call, process_str, port_str, prt->name, command, size); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_call)) { + lttng_decl_procbuf(proc_str); + lttng_decl_portbuf(port_str); + lttng_pid_to_str(caller,proc_str); + lttng_port_to_str(prt, port_str); + LTTNG5(driver_call, proc_str, port_str, prt->name, command, size); + } +#endif ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_PORT); @@ -5266,6 +5336,15 @@ int async_ready(Port *p, void* data) DTRACE3(driver_ready_async, process_str, port_str, p->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_ready_async)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(p), proc_str); + lttng_port_to_str(p, port_str); + LTTNG3(driver_ready_async, proc_str, port_str, p->name); + } +#endif (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); need_free = 0; ERTS_MSACC_POP_STATE_M(); @@ -7312,6 +7391,15 @@ void erts_fire_port_monitor(Port *prt, Eterm ref) DTRACE3(driver_process_exit, process_str, port_str, prt->name); } #endif +#ifdef USE_LTTNG_VM_TRACEPOINTS + if (LTTNG_ENABLED(driver_process_exit)) { + lttng_decl_portbuf(port_str); + lttng_decl_procbuf(proc_str); + lttng_pid_to_str(ERTS_PORT_GET_CONNECTED(prt), proc_str); + lttng_port_to_str(prt, port_str); + LTTNG3(driver_process_exit, proc_str, port_str, prt->name); + } +#endif fpe_was_unmasked = erts_block_fpe(); (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); erts_unblock_fpe(fpe_was_unmasked); @@ -7789,6 +7877,8 @@ init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) int fpe_was_unmasked = erts_block_fpe(); DTRACE4(driver_init, drv->name, drv->version.major, drv->version.minor, drv->flags); + LTTNG4(driver_init, drv->name, drv->version.major, drv->version.minor, + drv->flags); res = (*de->init)(); erts_unblock_fpe(fpe_was_unmasked); return res; diff --git a/erts/emulator/beam/lttng-wrapper.h b/erts/emulator/beam/lttng-wrapper.h new file mode 100644 index 0000000000..294872c365 --- /dev/null +++ b/erts/emulator/beam/lttng-wrapper.h @@ -0,0 +1,107 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2016. 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% + */ + +#ifndef __LTTNG_WRAPPER_H__ +#define __LTTNG_WRAPPER_H__ + +#ifdef USE_LTTNG + +#include "erlang_lttng.h" +#define USE_LTTNG_VM_TRACEPOINTS + +#define LTTNG_BUFFER_SZ (256) +#define LTTNG_PROC_BUFFER_SZ (16) +#define LTTNG_PORT_BUFFER_SZ (20) +#define LTTNG_MFA_BUFFER_SZ (256) + +#define lttng_decl_procbuf(Name) \ + char Name[LTTNG_PROC_BUFFER_SZ] + +#define lttng_decl_portbuf(Name) \ + char Name[LTTNG_PORT_BUFFER_SZ] + +#define lttng_decl_mfabuf(Name) \ + char Name[LTTNG_MFA_BUFFER_SZ] + +#define lttng_decl_carrier_stats(Name) \ + lttng_carrier_stats_t Name##_STATSTRUCT, *Name = &Name##_STATSTRUCT + +#define lttng_pid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PROC_BUFFER_SZ, "%T", (pid)) + +#define lttng_portid_to_str(pid, name) \ + erts_snprintf(name, LTTNG_PORT_BUFFER_SZ, "%T", (pid)) + +#define lttng_proc_to_str(p, name) \ + lttng_pid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PID), name) + +#define lttng_port_to_str(p, name) \ + lttng_portid_to_str(((p) ? (p)->common.id : ERTS_INVALID_PORT), name) + +#define lttng_mfa_to_str(m,f,a, Name) \ + erts_snprintf(Name, LTTNG_MFA_BUFFER_SZ, "%T:%T/%lu", (Eterm)(m), (Eterm)(f), (Uint)(a)) + +#define lttng_proc_to_mfa_str(p, Name) \ + do { \ + if (ERTS_PROC_IS_EXITING((p))) { \ + strcpy(Name, "<exiting>"); \ + } else { \ + BeamInstr *_fptr = find_function_from_pc((p)->i); \ + if (_fptr) { \ + lttng_mfa_to_str(_fptr[0],_fptr[1],_fptr[2], Name); \ + } else { \ + strcpy(Name, "<unknown>"); \ + } \ + } \ + } while(0) + +/* ErtsRunQueue->ErtsSchedulerData->Uint */ +#define lttng_rq_to_id(RQ) \ + (RQ)->scheduler->no + +#define LTTNG_ENABLED(Name) \ + tracepoint_enabled(com_ericsson_otp, Name) + +/* include a special LTTNG_DO for do_tracepoint ? */ +#define LTTNG1(Name, Arg1) \ + tracepoint(com_ericsson_otp, Name, (Arg1)) + +#define LTTNG2(Name, Arg1, Arg2) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2)) + +#define LTTNG3(Name, Arg1, Arg2, Arg3) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3)) + +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4)) + +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) \ + tracepoint(com_ericsson_otp, Name, (Arg1), (Arg2), (Arg3), (Arg4), (Arg5)) + +#else /* USE_LTTNG */ + +#define LTTNG1(Name, Arg1) do {} while(0) +#define LTTNG2(Name, Arg1, Arg2) do {} while(0) +#define LTTNG3(Name, Arg1, Arg2, Arg3) do {} while(0) +#define LTTNG4(Name, Arg1, Arg2, Arg3, Arg4) do {} while(0) +#define LTTNG5(Name, Arg1, Arg2, Arg3, Arg4, Arg5) do {} while(0) + +#endif /* USE_LTTNG */ +#endif /* __LTTNG_WRAPPER_H__ */ diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 772460c177..96a3a72bb5 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -181,11 +181,6 @@ i_jump_on_val_zero y f I i_jump_on_val x f I I i_jump_on_val y f I I -jump Target | label Lbl | same_label(Target, Lbl) => label Lbl - -is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ - is_eq_exact Fail S1 S2 | label L2 - %macro: get_list GetList -pack get_list x x x get_list x x y @@ -256,7 +251,14 @@ case_end x badmatch x if_end -raise s s + +# Operands for raise/2 are almost always in x(2) and x(1). +# Optimize for that case. +raise x==2 x==1 => i_raise +raise Trace=y Value=y => move Trace x=2 | move Value x=1 | i_raise +raise Trace Value => move Trace x=3 | move Value x=1 | move x=3 x=2 | i_raise + +i_raise # Internal now, but could be useful to make known to the compiler. badarg j @@ -1355,9 +1357,7 @@ bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src - -i_bs_put_utf16 j I s +bs_put_utf16 j I s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1539,7 +1539,6 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # -gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 3088dfd572..ee14bd8bba 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -2900,12 +2900,12 @@ file_output(ErlDrvData e, char* buf, ErlDrvSizeT count) d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + FILENAME_BYTELEN(buf + 9*4) + FILENAME_CHARSIZE); - d->info.mode = get_int32(buf + 0 * 4); - d->info.uid = get_int32(buf + 1 * 4); - d->info.gid = get_int32(buf + 2 * 4); - d->info.accessTime = (time_t)((Sint64)get_int64(buf + 3 * 4)); - d->info.modifyTime = (time_t)((Sint64)get_int64(buf + 5 * 4)); - d->info.cTime = (time_t)((Sint64)get_int64(buf + 7 * 4)); + d->info.mode = get_int32(buf + 0 * 4); + d->info.uid = get_int32(buf + 1 * 4); + d->info.gid = get_int32(buf + 2 * 4); + d->info.accessTime = get_int64(buf + 3 * 4); + d->info.modifyTime = get_int64(buf + 5 * 4); + d->info.cTime = get_int64(buf + 7 * 4); FILENAME_COPY(d->b, buf + 9*4); #ifdef USE_VM_PROBES diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h index be5a891486..7ffeed6b9d 100644 --- a/erts/emulator/drivers/common/erl_efile.h +++ b/erts/emulator/drivers/common/erl_efile.h @@ -105,9 +105,9 @@ typedef struct _Efile_info { Uint32 inode; /* Inode number. */ Uint32 uid; /* User id of owner. */ Uint32 gid; /* Group id of owner. */ - time_t accessTime; /* Last time the file was accessed. */ - time_t modifyTime; /* Last time the file was modified. */ - time_t cTime; /* Creation time (Windows) or last + Sint64 accessTime; /* Last time the file was accessed. */ + Sint64 modifyTime; /* Last time the file was modified. */ + Sint64 cTime; /* Creation time (Windows) or last * inode change (Unix). */ } Efile_info; diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index ac9b681d03..0861435264 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -537,9 +537,9 @@ efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, else pInfo->type = FT_OTHER; - pInfo->accessTime = statbuf.st_atime; - pInfo->modifyTime = statbuf.st_mtime; - pInfo->cTime = statbuf.st_ctime; + pInfo->accessTime = (Sint64)statbuf.st_atime; + pInfo->modifyTime = (Sint64)statbuf.st_mtime; + pInfo->cTime = (Sint64)statbuf.st_ctime; pInfo->mode = statbuf.st_mode; pInfo->links = statbuf.st_nlink; @@ -578,8 +578,8 @@ efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) } } - tval.actime = pInfo->accessTime; - tval.modtime = pInfo->modifyTime; + tval.actime = (time_t)pInfo->accessTime; + tval.modtime = (time_t)pInfo->modifyTime; return check_error(utime(name, &tval), errInfo); } @@ -638,12 +638,21 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ do { w = writev(fd, &iov[cnt], b); } while (w < 0 && errno == EINTR); + if (w < 0 && errno == EINVAL) { + goto single_write; + } } else + single_write: /* Degenerated io vector - use regular write */ #endif { do { - w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); + size_t iov_len = iov[cnt].iov_len; + size_t limit = 1024*1024*1024; /* 1GB */ + if (iov_len > limit) { + iov_len = limit; + } + w = write(fd, iov[cnt].iov_base, iov_len); } while (w < 0 && errno == EINTR); ASSERT(w <= iov[cnt].iov_len || (w == -1 && errno != EINTR)); diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c index f87196d724..0d5043fa2a 100644 --- a/erts/emulator/sys/common/erl_check_io.c +++ b/erts/emulator/sys/common/erl_check_io.c @@ -39,6 +39,7 @@ #include "erl_check_io.h" #include "erl_thr_progress.h" #include "dtrace-wrapper.h" +#include "lttng-wrapper.h" #define ERTS_WANT_TIMER_WHEEL_API #include "erl_time.h" @@ -395,6 +396,7 @@ forget_removed(struct pollset_info* psi) if (drv_ptr) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, drv_ptr->name); + LTTNG1(driver_stop_select, drv_ptr->name); (*drv_ptr->stop_select) ((ErlDrvEvent) fd, NULL); erts_unblock_fpe(was_unmasked); if (drv_ptr->handle) { @@ -1055,6 +1057,7 @@ done_unknown: if (stop_select_fn) { int was_unmasked = erts_block_fpe(); DTRACE1(driver_stop_select, name); + LTTNG1(driver_stop_select, "unknown"); (*stop_select_fn)(e, NULL); erts_unblock_fpe(was_unmasked); } diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile index 318db4b45e..0f716c11a1 100644 --- a/erts/emulator/test/Makefile +++ b/erts/emulator/test/Makefile @@ -70,6 +70,7 @@ MODULES= \ hash_SUITE \ hibernate_SUITE \ list_bif_SUITE \ + lttng_SUITE \ map_SUITE \ match_spec_SUITE \ module_info_SUITE \ diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl index 1f690c5015..03b020c521 100644 --- a/erts/emulator/test/alloc_SUITE.erl +++ b/erts/emulator/test/alloc_SUITE.erl @@ -55,21 +55,13 @@ end_per_testcase(_Case, Config) when is_list(Config) -> %% %% basic(Cfg) -> drv_case(Cfg). - coalesce(Cfg) -> drv_case(Cfg). - threads(Cfg) -> drv_case(Cfg). - realloc_copy(Cfg) -> drv_case(Cfg). - bucket_index(Cfg) -> drv_case(Cfg). - bucket_mask(Cfg) -> drv_case(Cfg). - rbtree(Cfg) -> drv_case(Cfg). - mseg_clear_cache(Cfg) -> drv_case(Cfg). - cpool(Cfg) -> drv_case(Cfg). migration(Cfg) -> @@ -81,7 +73,7 @@ migration(Cfg) -> end. erts_mmap(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {unix, _} -> [erts_mmap_do(Config, SCO, SCRPM, SCRFSD) || SCO <-[true,false], SCRFSD <-[1234,0], SCRPM <- [true,false]]; @@ -109,25 +101,26 @@ erts_mmap_do(Config, SCO, SCRPM, SCRFSD) -> {ok, Node} = start_node(Config, Opts), Self = self(), Ref = make_ref(), - F = fun () -> - SI = erlang:system_info({allocator,mseg_alloc}), - {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), - {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), - {sizes,Sizes} = lists:keyfind(sizes, 1, SC), - {free_segs,Segs} = lists:keyfind(free_segs,1,SC), - {total,Total} = lists:keyfind(total,1,Sizes), - Total = SCS*1024*1024, - - {reserved,Reserved} = lists:keyfind(reserved,1,Segs), - true = (Reserved >= SCRFSD), - - case {SCO,lists:keyfind(os,1,EM)} of - {true, false} -> ok; - {false, {os,_}} -> ok - end, - - Self ! {Ref, ok} - end, + F = fun() -> + SI = erlang:system_info({allocator,mseg_alloc}), + {erts_mmap,EM} = lists:keyfind(erts_mmap, 1, SI), + {supercarrier,SC} = lists:keyfind(supercarrier, 1, EM), + {sizes,Sizes} = lists:keyfind(sizes, 1, SC), + {free_segs,Segs} = lists:keyfind(free_segs,1,SC), + {total,Total} = lists:keyfind(total,1,Sizes), + io:format("Expecting total ~w, got ~w~n", [SCS*1024*1024,Total]), + Total = SCS*1024*1024, + + {reserved,Reserved} = lists:keyfind(reserved,1,Segs), + true = (Reserved >= SCRFSD), + + case {SCO,lists:keyfind(os,1,EM)} of + {true, false} -> ok; + {false, {os,_}} -> ok + end, + + Self ! {Ref, ok} + end, spawn_link(Node, F), Result = receive {Ref, Rslt} -> Rslt end, @@ -144,7 +137,7 @@ drv_case(Config) -> drv_case(Config, one_shot, ""). drv_case(Config, Mode, NodeOpts) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {Family, _} when Family == unix; Family == win32 -> {ok, Node} = start_node(Config, NodeOpts), Self = self(), diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl index f116ec979b..b068a4c8d2 100644 --- a/erts/emulator/test/distribution_SUITE.erl +++ b/erts/emulator/test/distribution_SUITE.erl @@ -1034,6 +1034,7 @@ atom_roundtrip(Config) when is_list(Config) -> atom_roundtrip_r15b(Config) when is_list(Config) -> case test_server:is_release_available("r15b") of true -> + ct:timetrap({minutes, 6}), AtomData = atom_data(), verify_atom_data(AtomData), {ok, Node} = start_node(Config, [], "r15b"), diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl index 41a761229c..294d9ee05f 100644 --- a/erts/emulator/test/erl_drv_thread_SUITE.erl +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -65,7 +65,7 @@ drv_case(Config, CaseName, Command, TimeTrap) when is_list(Config), is_atom(CaseName), is_list(Command), is_integer(TimeTrap) -> - case test_server:os_type() of + case os:type() of {Family, _} when Family == unix; Family == win32 -> run_drv_case(Config, CaseName, Command, TimeTrap); SkipOs -> diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl index 7373303a39..da6f6850c6 100644 --- a/erts/emulator/test/ignore_cores.erl +++ b/erts/emulator/test/ignore_cores.erl @@ -94,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), end, ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), %% cores are dumped in /cores on MacOS X - CoresDir = case {test_server:os_type(), filelib:is_dir("/cores")} of + CoresDir = case {os:type(), filelib:is_dir("/cores")} of {{unix,darwin}, true} -> filelib:fold_files("/cores", "^core.*$", diff --git a/erts/emulator/test/lttng_SUITE.erl b/erts/emulator/test/lttng_SUITE.erl new file mode 100644 index 0000000000..d0f6292d5b --- /dev/null +++ b/erts/emulator/test/lttng_SUITE.erl @@ -0,0 +1,499 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. 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% +%% + +-module(lttng_SUITE). + +-export([all/0, suite/0]). +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2]). + +-export([t_lttng_list/1, + t_carrier_pool/1, + t_memory_carrier/1, + t_async_io_pool/1, + t_driver_control_ready_async/1, + t_driver_start_stop/1, + t_driver_ready_input_output/1, + t_driver_timeout/1, + t_driver_caller/1, + t_driver_flush/1, + t_scheduler_poll/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {seconds, 10}}]. + +all() -> + [t_lttng_list, + t_carrier_pool, + t_async_io_pool, + t_driver_start_stop, + t_driver_ready_input_output, + t_driver_control_ready_async, + t_driver_timeout, + t_driver_caller, + t_driver_flush, + t_scheduler_poll, + t_memory_carrier]. + + +init_per_suite(Config) -> + case erlang:system_info(dynamic_trace) of + lttng -> + ensure_lttng_stopped("--all"), + Config; + _ -> + {skip, "No LTTng configured on system."} + end. + +end_per_suite(_Config) -> + ensure_lttng_stopped("--all"), + ok. + +init_per_testcase(Case, Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_started(Name, Config), + [{session, Name}|Config]. + +end_per_testcase(Case, _Config) -> + Name = atom_to_list(Case), + ok = ensure_lttng_stopped(Name), + ok. + +%% Not tested yet +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_event + +%% tracepoints +%% +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_get +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_finish +%% com_ericsson_otp:driver_ready_async +%% com_ericsson_otp:driver_process_exit +%% com_ericsson_otp:driver_stop +%% com_ericsson_otp:driver_flush +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +%% com_ericsson_otp:driver_event +%% com_ericsson_otp:driver_ready_output +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:scheduler_poll + +%% +%% Testcases +%% + +t_lttng_list(_Config) -> + {ok, _} = cmd("lttng list -u"), + ok. + +%% com_ericsson_otp:carrier_pool_get +%% com_ericsson_otp:carrier_pool_put +t_carrier_pool(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_pool*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_get", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_pool_put", Res), + ok + end. + +%% com_ericsson_otp:carrier_destroy +%% com_ericsson_otp:carrier_create +t_memory_carrier(Config) -> + case have_carriers() of + false -> + {skip, "No Memory Carriers configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:carrier_*", Config), + + ok = ets_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:carrier_destroy", Res), + ok = check_tracepoint("com_ericsson_otp:carrier_create", Res), + ok + end. + +%% com_ericsson_otp:aio_pool_add +%% com_ericsson_otp:aio_pool_get +t_async_io_pool(Config) -> + case have_async_threads() of + false -> + {skip, "No Async Threads configured on system."}; + true -> + ok = lttng_start_event("com_ericsson_otp:aio_pool_*", Config), + + Path1 = proplists:get_value(priv_dir, Config), + {ok, [[Path2]]} = init:get_argument(home), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + {ok, _} = file:list_dir(Path1), + {ok, _} = file:list_dir(Path2), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:aio_pool_add", Res), + ok = check_tracepoint("com_ericsson_otp:aio_pool_get", Res), + ok + end. + + +%% com_ericsson_otp:driver_start +%% com_ericsson_otp:driver_stop +t_driver_start_stop(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_start", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop", Res), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_control +%% com_ericsson_otp:driver_outputv +%% com_ericsson_otp:driver_ready_async +t_driver_control_ready_async(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_control", Config), + ok = lttng_start_event("com_ericsson_otp:driver_outputv", Config), + ok = lttng_start_event("com_ericsson_otp:driver_ready_async", Config), + Path = proplists:get_value(priv_dir, Config), + Name = filename:join(Path, "sometext.txt"), + Bin = txt(), + ok = file:write_file(Name, Bin), + {ok, Bin} = file:read_file(Name), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_control", Res), + ok = check_tracepoint("com_ericsson_otp:driver_outputv", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_async", Res), + ok. + +%% com_ericsson_otp:driver_ready_input +%% com_ericsson_otp:driver_ready_output +t_driver_ready_input_output(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_ready_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, active) end), + receive {Pid, accept} -> ok end, + Bin = txt(), + Sz = byte_size(Bin), + + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}]), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + ok = gen_tcp:close(Sock), + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_ready_input", Res), + ok = check_tracepoint("com_ericsson_otp:driver_ready_output", Res), + ok. + + +%% com_ericsson_otp:driver_stop_select +%% com_ericsson_otp:driver_timeout +t_driver_timeout(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, timeout) end), + receive {Pid, accept} -> ok end, + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary]), + ok = gen_tcp:send(Sock, <<"hej">>), + receive {Pid, done} -> ok end, + ok = gen_tcp:close(Sock), + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_timeout", Res), + ok = check_tracepoint("com_ericsson_otp:driver_stop_select", Res), + ok. + +%% com_ericsson_otp:driver_call +%% com_ericsson_otp:driver_output +%% com_ericsson_otp:driver_init +%% com_ericsson_otp:driver_finish +t_driver_caller(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_*", Config), + + Drv = 'caller_drv', + os:putenv("CALLER_DRV_USE_OUTPUTV", "false"), + + ok = load_driver(proplists:get_value(data_dir, Config), Drv), + Port = open_port({spawn, Drv}, []), + true = is_port(Port), + + chk_caller(Port, start, self()), + chk_caller(Port, output, spawn_link(fun() -> + port_command(Port, "") + end)), + Port ! {self(), {command, ""}}, + chk_caller(Port, output, self()), + chk_caller(Port, control, spawn_link(fun () -> + port_control(Port, 0, "") + end)), + chk_caller(Port, call, spawn_link(fun() -> + erlang:port_call(Port, 0, "") + end)), + + true = port_close(Port), + erl_ddll:unload_driver(Drv), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_call", Res), + ok = check_tracepoint("com_ericsson_otp:driver_output", Res), + ok = check_tracepoint("com_ericsson_otp:driver_init", Res), + ok = check_tracepoint("com_ericsson_otp:driver_finish", Res), + ok. + +%% com_ericsson_otp:scheduler_poll +t_scheduler_poll(Config) -> + ok = lttng_start_event("com_ericsson_otp:scheduler_poll", Config), + + ok = memory_load(), + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:scheduler_poll", Res), + ok. + +%% com_ericsson_otp:driver_flush +t_driver_flush(Config) -> + ok = lttng_start_event("com_ericsson_otp:driver_flush", Config), + + Me = self(), + Pid = spawn_link(fun() -> tcp_server(Me, passive_no_read) end), + receive {Pid, accept} -> ok end, + Bin = iolist_to_binary([txt() || _ <- lists:seq(1,100)]), + Sz = byte_size(Bin), + + %% We want to create a scenario where sendings stalls and we + %% queue packets in the driver. + %% When we close the socket it has to flush the queue. + {ok, Sock} = gen_tcp:connect("localhost", 5679, [binary, {packet, 2}, + {send_timeout, 10}, + {sndbuf, 10000000}]), + Pids = [spawn_link(fun() -> + gen_tcp:send(Sock, <<Sz:16, Bin/binary>>), + Me ! {self(), ok} + end) || _ <- lists:seq(1,100)], + [receive {P, ok} -> ok end || P <- Pids], + ok = gen_tcp:close(Sock), + Pid ! die, + receive {Pid, done} -> ok end, + + Res = lttng_stop_and_view(Config), + ok = check_tracepoint("com_ericsson_otp:driver_flush", Res), + ok. + +%% +%% AUX +%% + +chk_caller(Port, Callback, ExpectedCaller) -> + receive + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller + end. + + +ets_load() -> + Tid = ets:new(ets_load, [public,set]), + N = erlang:system_info(schedulers_online), + Pids = [spawn_link(fun() -> ets_shuffle(Tid) end) || _ <- lists:seq(1,N)], + ok = ets_kill(Pids, 500), + ok. + + +ets_kill([], _) -> ok; +ets_kill([Pid|Pids], Time) -> + timer:sleep(Time), + Pid ! done, + ets_kill(Pids, Time). + +ets_shuffle(Tid) -> + Payload = lists:duplicate(100, $x), + ets_shuffle(Tid, 100, Payload). +ets_shuffle(Tid, I, Data) -> + ets_shuffle(Tid, I, I, Data, Data). + +ets_shuffle(Tid, 0, N, _, Data) -> + ets_shuffle(Tid, N, N, Data, Data); +ets_shuffle(Tid, I, N, Data, Data0) -> + receive + done -> ok + after 0 -> + Key = rand:uniform(1000), + Data1 = [I|Data], + ets:insert(Tid, {Key, Data1}), + ets_shuffle(Tid, I - 1, N, Data1, Data0) + end. + + + + +memory_load() -> + Me = self(), + Pids0 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + timer:sleep(50), + Pids1 = [spawn_link(fun() -> memory_loop(Me, 20, <<42>>) end) || _ <- lists:seq(1,30)], + [receive {Pid, done} -> ok end || Pid <- Pids0 ++ Pids1], + timer:sleep(500), + ok. + +memory_loop(Parent, N, Bin) -> + memory_loop(Parent, N, Bin, []). + +memory_loop(Parent, 0, _Bin, _) -> + Parent ! {self(), done}; +memory_loop(Parent, N, Bin0, Ls) -> + Bin = binary:copy(<<Bin0/binary, Bin0/binary>>), + memory_loop(Parent, N - 1, Bin, [a,b,c|Ls]). + +tcp_server(Pid, Type) -> + {ok, LSock} = gen_tcp:listen(5679, [binary, + {reuseaddr, true}, + {active, false}]), + Pid ! {self(), accept}, + {ok, Sock} = gen_tcp:accept(LSock), + case Type of + passive_no_read -> + receive die -> ok end; + active -> + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg1 -> io:format("msg1: ~p~n", [Msg1]) end, + inet:setopts(Sock, [{active, once}, {packet,2}]), + receive Msg2 -> io:format("msg2: ~p~n", [Msg2]) end, + ok = gen_tcp:close(Sock); + timeout -> + Res = gen_tcp:recv(Sock, 2000, 1000), + io:format("res ~p~n", [Res]) + end, + Pid ! {self(), done}, + ok. + +txt() -> + <<"%% tracepoints\n" + "%%\n" + "%% com_ericsson_otp:carrier_pool_get\n" + "%% com_ericsson_otp:carrier_pool_put\n" + "%% com_ericsson_otp:carrier_destroy\n" + "%% com_ericsson_otp:carrier_create\n" + "%% com_ericsson_otp:aio_pool_add\n" + "%% com_ericsson_otp:aio_pool_get\n" + "%% com_ericsson_otp:driver_control\n" + "%% com_ericsson_otp:driver_call\n" + "%% com_ericsson_otp:driver_finish\n" + "%% com_ericsson_otp:driver_ready_async\n" + "%% com_ericsson_otp:driver_process_exit\n" + "%% com_ericsson_otp:driver_stop\n" + "%% com_ericsson_otp:driver_flush\n" + "%% com_ericsson_otp:driver_stop_select\n" + "%% com_ericsson_otp:driver_timeout\n" + "%% com_ericsson_otp:driver_event\n" + "%% com_ericsson_otp:driver_ready_output\n" + "%% com_ericsson_otp:driver_ready_input\n" + "%% com_ericsson_otp:driver_output\n" + "%% com_ericsson_otp:driver_outputv\n" + "%% com_ericsson_otp:driver_init\n" + "%% com_ericsson_otp:driver_start\n" + "%% com_ericsson_otp:scheduler_poll">>. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +%% check + +have_carriers() -> + Cap = element(3,erlang:system_info(allocator)), + case Cap -- [sys_alloc,sys_aligned_alloc] of + [] -> false; + _ -> true + end. + +have_async_threads() -> + Tps = erlang:system_info(thread_pool_size), + if Tps =:= 0 -> false; + true -> true + end. + +%% lttng +lttng_stop_and_view(Config) -> + Path = proplists:get_value(priv_dir, Config), + Name = proplists:get_value(session, Config), + {ok,_} = cmd("lttng stop " ++ Name), + {ok,Res} = cmd("lttng view " ++ Name ++ " --trace-path=" ++ Path), + Res. + +check_tracepoint(TP, Data) -> + case re:run(Data, TP, [global]) of + {match, _} -> ok; + _ -> notfound + end. + +lttng_start_event(Event, Config) -> + Name = proplists:get_value(session, Config), + {ok, _} = cmd("lttng enable-event -u " ++ Event ++ " --session=" ++ Name), + {ok, _} = cmd("lttng start " ++ Name), + ok. + +ensure_lttng_started(Name, Config) -> + Out = case proplists:get_value(priv_dir, Config) of + undefined -> []; + Path -> "--output="++Path++" " + end, + {ok,_} = cmd("lttng create " ++ Out ++ Name), + ok. + +ensure_lttng_stopped(Name) -> + {ok,_} = cmd("lttng stop"), + {ok,_} = cmd("lttng destroy " ++ Name), + ok. + +cmd(Cmd) -> + io:format("<< ~ts~n", [Cmd]), + Res = os:cmd(Cmd), + io:format(">> ~ts~n", [Res]), + {ok,Res}. diff --git a/erts/emulator/test/lttng_SUITE_data/Makefile.src b/erts/emulator/test/lttng_SUITE_data/Makefile.src new file mode 100644 index 0000000000..fe7a1b6ef3 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ + +MISC_DRVS = caller_drv@dll@ + + +all: $(MISC_DRVS) + +@SHLIB_RULES@ diff --git a/erts/emulator/test/lttng_SUITE_data/caller_drv.c b/erts/emulator/test/lttng_SUITE_data/caller_drv.c new file mode 100644 index 0000000000..86fd0a2995 --- /dev/null +++ b/erts/emulator/test/lttng_SUITE_data/caller_drv.c @@ -0,0 +1,159 @@ +/* ``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. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include <stdlib.h> +#include <string.h> +#include "erl_driver.h" + +static int init(); +static void stop(ErlDrvData drv_data); +static void finish(); +static void flush(ErlDrvData drv_data); +static ErlDrvData start(ErlDrvPort port, char *command); +static void output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len); +static void outputv(ErlDrvData drv_data, ErlIOVec *ev); +static ErlDrvSSizeT control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen); +static ErlDrvSSizeT call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags); + +static ErlDrvEntry caller_drv_entry = { + init, + start, + stop, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "caller_drv", + finish, + NULL /* handle */, + control, + NULL /* timeout */, + outputv, + NULL /* ready_async */, + flush, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(caller_drv) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + caller_drv_entry.outputv = NULL; + return &caller_drv_entry; +} + +void +send_caller(ErlDrvData drv_data, char *func) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom(func), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 4 + }; + res = erl_drv_output_term(driver_mk_port(port), msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "erl_drv_output_term failed"); +} + +static int +init() { + return 0; +} + +static void +stop(ErlDrvData drv_data) +{ + +} + +static void +flush(ErlDrvData drv_data) +{ + +} + +static void +finish() +{ + +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + send_caller((ErlDrvData) port, "start"); + return (ErlDrvData) port; +} + +static void +output(ErlDrvData drv_data, char *buf, ErlDrvSizeT len) +{ + send_caller(drv_data, "output"); +} + +static void +outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + send_caller(drv_data, "outputv"); +} + +static ErlDrvSSizeT +control(ErlDrvData drv_data, + unsigned int command, char *buf, + ErlDrvSizeT len, char **rbuf, ErlDrvSizeT rlen) +{ + send_caller(drv_data, "control"); + return 0; +} + +static ErlDrvSSizeT +call(ErlDrvData drv_data, + unsigned int command, + char *buf, ErlDrvSizeT len, + char **rbuf, ErlDrvSizeT rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + send_caller(drv_data, "call"); + return len; +} diff --git a/erts/emulator/test/multi_load_SUITE.erl b/erts/emulator/test/multi_load_SUITE.erl index 784b239116..e8769ea208 100644 --- a/erts/emulator/test/multi_load_SUITE.erl +++ b/erts/emulator/test/multi_load_SUITE.erl @@ -19,32 +19,16 @@ %% -module(multi_load_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - many/1,on_load/1,errors/1]). +-export([all/0, suite/0, many/1, on_load/1, errors/1]). -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [many,on_load,errors]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - many(_Config) -> Ms = make_modules(100, fun many_module/1), @@ -57,7 +41,6 @@ many(_Config) -> io:put_chars("Heavy load\n" "=========="), many_measure(Ms), - ok. many_module(M) -> @@ -81,9 +64,12 @@ many_measure(Ms) -> "Sequential: ~9w µs\n" "Parallel: ~9w µs\n" "Ratio: ~9w\n", - [length(Ms),Us1,Us2,round(Us1/Us2)]), + [length(Ms),Us1,Us2,divide(Us1,Us2)]), ok. +divide(A,B) when B > 0 -> A div B; +divide(_,_) -> inf. + many_load_seq(Ms) -> [erlang:finish_loading([M]) || M <- Ms], ok. @@ -135,7 +121,6 @@ on_load(_Config) -> SingleOnPrep = tl(OnPrep), {on_load,[OnLoadMod]} = erlang:finish_loading(SingleOnPrep), ok = erlang:call_on_load_function(OnLoadMod), - ok. on_load_module(M) -> diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl index 71400142af..d1f90c952a 100644 --- a/erts/emulator/test/node_container_SUITE.erl +++ b/erts/emulator/test/node_container_SUITE.erl @@ -28,8 +28,6 @@ -module(node_container_SUITE). -author('[email protected]'). -%-define(line_trace, 1). - -include_lib("common_test/include/ct.hrl"). -export([all/0, suite/0, init_per_suite/1, end_per_suite/1, @@ -56,7 +54,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 10}}]. + {timetrap, {minutes, 12}}]. all() -> @@ -126,7 +124,13 @@ term_to_binary_to_term_eq(Config) when is_list(Config) -> LHLRef = binary_to_term(term_to_binary(LHLRef)), LSRef = binary_to_term(term_to_binary(LSRef)), % Get remote node containers - RNode = {get_nodename(), 3}, + ttbtteq_do_remote({get_nodename(), 3}), + ttbtteq_do_remote({get_nodename(), 4}), + ttbtteq_do_remote({get_nodename(), 16#adec0ded}), + nc_refc_check(node()), + ok. + +ttbtteq_do_remote(RNode) -> RPid = mk_pid(RNode, 4711, 1), RXPid = mk_pid(RNode, 32767, 8191), RPort = mk_port(RNode, 4711), @@ -142,7 +146,6 @@ term_to_binary_to_term_eq(Config) when is_list(Config) -> RLRef = binary_to_term(term_to_binary(RLRef)), RHLRef = binary_to_term(term_to_binary(RHLRef)), RSRef = binary_to_term(term_to_binary(RSRef)), - nc_refc_check(node()), ok. @@ -712,7 +715,7 @@ run_otp_4715(Config) when is_list(Config) -> pid_wrap(Config) when is_list(Config) -> pp_wrap(pid). port_wrap(Config) when is_list(Config) -> - case test_server:os_type() of + case os:type() of {unix, _} -> pp_wrap(port); _ -> @@ -807,7 +810,7 @@ bad_nc(Config) when is_list(Config) -> = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), {'EXIT', {badarg, mk_ref, _}} = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), - BadNode = {x@y, 4}, + BadNode = {x@y, bad_creation}, {'EXIT', {badarg, mk_pid, _}} = (catch mk_pid(BadNode, 4711, 17)), {'EXIT', {badarg, mk_port, _}} @@ -842,11 +845,10 @@ iter_max_procs(Config) when is_list(Config) -> Res = chk_max_proc_line(), Res = chk_max_proc_line(), done = chk_max_proc_line_until(NoMoreTests, Res), - {comment, - io_lib:format("max processes = ~p; " - "process line length = ~p", - [element(2, Res), element(1, Res)])}. - + Cmt = io_lib:format("max processes = ~p; " + "process line length = ~p", + [element(2, Res), element(1, Res)]), + {comment, lists:flatten(Cmt)}. max_proc_line(Root, Parent, N) -> Me = self(), @@ -1111,6 +1113,9 @@ get_nodename() -> -define(PORT_EXT, 102). -define(PID_EXT, 103). -define(NEW_REFERENCE_EXT, 114). +-define(NEW_PID_EXT, $X). +-define(NEW_PORT_EXT, $Y). +-define(NEWER_REFERENCE_EXT, $Z). uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> [(Uint bsr 24) band 16#ff, @@ -1133,51 +1138,65 @@ uint8(Uint) -> exit({badarg, uint8, [Uint]}). +pid_tag(bad_creation) -> ?PID_EXT; +pid_tag(Creation) when Creation =< 3 -> ?PID_EXT; +pid_tag(_Creation) -> ?NEW_PID_EXT. + +enc_creation(bad_creation) -> uint8(4); +enc_creation(Creation) when Creation =< 3 -> uint8(Creation); +enc_creation(Creation) -> uint32_be(Creation). mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of - Pid when is_pid(Pid) -> - Pid; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + pid_tag(Creation), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + enc_creation(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. +port_tag(bad_creation) -> ?PORT_EXT; +port_tag(Creation) when Creation =< 3 -> ?PORT_EXT; +port_tag(_Creation) -> ?NEW_PORT_EXT. + mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Port when is_port(Port) -> - Port; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_port, [{NodeName, Creation}, Number]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + port_tag(Creation), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + enc_creation(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeName, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. +ref_tag(bad_creation) -> ?NEW_REFERENCE_EXT; +ref_tag(Creation) when Creation =< 3 -> ?NEW_REFERENCE_EXT; +ref_tag(_Creation) -> ?NEWER_REFERENCE_EXT. + mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), - is_integer(Number) -> + Creation =< 3, + is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, ?REFERENCE_EXT, ?ATOM_EXT, @@ -1193,25 +1212,24 @@ mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, - uint16_be(length(Numbers)), - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint8(Creation), - lists:map(fun (N) -> - uint32_be(N) - end, - Numbers)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ref_tag(Creation), + uint16_be(length(Numbers)), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + enc_creation(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. exec_loop() -> diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl index 562cf1c92d..cb683b9cbf 100644 --- a/erts/emulator/test/op_SUITE.erl +++ b/erts/emulator/test/op_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, - {timetrap, {minutes, 3}}]. + {timetrap, {minutes, 5}}]. all() -> [bsl_bsr, logical, t_not, relop_simple, relop, @@ -39,9 +39,16 @@ all() -> %% Test the bsl and bsr operators. bsl_bsr(Config) when is_list(Config) -> Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]], - Cases = [{Op,X,Y} || Op <- ['bsr','bsl'], X <- Vs, Y <- Vs], - run_test_module(Cases, false), - {comment,integer_to_list(length(Cases)) ++ " cases"}. + %% Try to use less memory by splitting the cases + + Cases1 = [{Op,X,Y} || Op <- ['bsl'], X <- Vs, Y <- Vs], + N1 = length(Cases1), + run_test_module(Cases1, false), + + Cases2 = [{Op,X,Y} || Op <- ['bsr'], X <- Vs, Y <- Vs], + N2 = length(Cases2), + run_test_module(Cases2, false), + {comment,integer_to_list(N1 + N2) ++ " cases"}. %% Test the logical operators and internal BIFs. logical(Config) when is_list(Config) -> diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl index 328641f5b9..cfbc664b56 100644 --- a/erts/emulator/test/port_SUITE.erl +++ b/erts/emulator/test/port_SUITE.erl @@ -908,7 +908,7 @@ try_bad_env(Env) -> %% Test that we can handle a very very large environment gracefully. huge_env(Config) when is_list(Config) -> - ct:timetrap({seconds, 30}), + ct:timetrap({minutes, 2}), Vars = case os:type() of {win32,_} -> 500; _ -> @@ -1757,7 +1757,7 @@ otp_6224_loop() -> exit_status_multi_scheduling_block(Config) when is_list(Config) -> Repeat = 3, - case test_server:os_type() of + case os:type() of {unix, _} -> ct:timetrap({minutes, 2*Repeat}), SleepSecs = 6, diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index 5bb216ff79..789fa7cf06 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -1003,7 +1003,7 @@ low_prio_test(Config) when is_list(Config) -> process_flag(trap_exit, true), S = spawn_link(?MODULE, prio_server, [0, 0]), PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), - timer:sleep(2000), + ct:sleep({seconds,3}), lists:foreach(fun (P) -> exit(P, kill) end, PCs), S ! exit, receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 64c280b198..0b4b302908 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -876,7 +876,7 @@ get_affinity_mask(_Port, _Status, Affinity) -> Affinity. get_affinity_mask() -> - case test_server:os_type() of + case os:type() of {unix, linux} -> case catch open_port({spawn, "taskset -p " ++ os:getpid()}, [exit_status]) of @@ -1733,7 +1733,7 @@ sched_state([], N, DC, DI) -> {N, DC, DI} catch _ : _ -> - ?t:fail({inconsisten_scheduler_state, {N, DC, DI}}) + ct:fail({inconsisten_scheduler_state, {N, DC, DI}}) end; sched_state([{normal, _, _, _} = S | Rest], _S, DC, DI) -> sched_state(Rest, S, DC, DI); diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index f805e7cc64..2e7073a8f0 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -113,7 +113,6 @@ my @if_line; # my $te_max_vars = 0; # Max number of variables ever needed. my %gen_transform; -my %min_window; my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; @@ -382,7 +381,6 @@ while (<>) { $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; $obsolete[$op_num] = defined $obsolete; } else { # Unnumbered generic operation. push(@unnumbered_generic, [$name, $arity]); @@ -440,7 +438,6 @@ $num_file_opcodes = @gen_opname; $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; } } @@ -607,7 +604,7 @@ sub emulator_output { $is_transformed{$name,$arity} or error("instruction $key has no specific instruction"); $spec_op = -1 unless defined $spec_op; - &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); + &init_item($name, $arity, $spec_op, $num_specific, $tr); } } print "};\n"; @@ -1405,8 +1402,7 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $used_ref = used_vars($from_ref, $to_ref); - my $so_far = tr_gen_from($line, $used_ref, @$from_ref); + my $so_far = tr_gen_from($line, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1457,58 +1453,14 @@ sub tr_gen { print "};\n\n"; } -sub used_vars { - my($from_ref,$to_ref) = @_; - my %used; - my %seen; - - foreach my $ref (@$from_ref) { - my($name,$arity,@ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - # Any variable that is used at least twice on the - # left-hand side is used. (E.g. "move R R".) - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1 if $seen{$var}; - $seen{$var} = 1; - } - } - } - - foreach my $ref (@$to_ref) { - my($name, $arity, @ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1; - } - } - } - \%used; -} - sub tr_gen_from { - my($line,$used_ref,@tr) = @_; + my($line,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; my(@code); - my($min_window) = 0; - my(@fix_rest_args); - my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; - my %var_used = %$used_ref; my $may_fail = 0; my $is_first = 1; @@ -1530,8 +1482,20 @@ sub tr_gen_from { my $var; my(@args); - push(@fix_pred_funcs, scalar(@code)); - push(@code, [$name, @ops]); + foreach $var (@ops) { + error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "rest_args"); + } + } + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + my $op = make_op("$name()", 'pred', $pi); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); next; } @@ -1544,7 +1508,6 @@ sub tr_gen_from { $opnum = $gen_opnum{$name,$arity}; push(@code, make_op("$name/$arity", 'next_instr', $opnum)); - $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; my $ignored_var = "$var (ignored)"; @@ -1593,15 +1556,21 @@ sub tr_gen_from { if (defined $var{$var}) { $ignored_var = ''; $may_fail = 1; - push(@code, &make_op($var, 'is_same_var', $var{$var})); + my $op = make_op($var, 'is_same_var', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type eq '*') { - # - # Reserve a hole for a 'rest_args' instruction. - # + foreach my $type (values %var_type) { + error("only one use of a '*' variable is " . + "allowed on the left hand side of " . + "a transformation") + if $type eq 'array'; + } $ignored_var = ''; - push(@fix_rest_args, scalar(@code)); - push(@code, $var); - } elsif ($var_used{$var}) { + $var{$var} = 'unnumbered'; + $var_type{$var} = 'array'; + push(@code, make_op($var, 'rest_args')); + } else { $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; @@ -1629,46 +1598,14 @@ sub tr_gen_from { # push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); - # - # If there is an rest_args instruction, we must insert its correct - # variable number (higher than any other). - # - my $index; - &error("only one use of a '*' variable is allowed on the left hand side of a transformation") - if @fix_rest_args > 1; - foreach $index (@fix_rest_args) { - my $var = $code[$index]; - $var{$var} = $var_num++; - $var_type{$var} = 'array'; - splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var})); - } - - foreach $index (@fix_pred_funcs) { - my($name, @ops) = @{$code[$index]}; - my(@args); - my $var; - - foreach $var (@ops) { - &error($where, "variable '$var' unbound") - unless defined $var{$var}; - if ($var_type{$var} eq 'scalar') { - push(@args, "var[$var{$var}]"); - } else { - push(@args, "var+$var{$var}"); - } - } - my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); - splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); - } - $te_max_vars = $var_num if $te_max_vars < $var_num; - [$min_window, \%var, \%var_type, \@code]; + [\%var, \%var_type, \@code]; } sub tr_gen_to { my($line, $orig_transform, $so_far, @tr) = @_; - my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far; + my($var_ref, $var_type_ref, $code_ref) = @$so_far; my(%var) = %$var_ref; my(%var_type) = %$var_type_ref; my(@code) = @$code_ref; @@ -1697,13 +1634,16 @@ sub tr_gen_to { if ($var_type{$var} eq 'scalar') { push(@args, "var[$var{$var}]"); } else { - push(@args, "var+$var{$var}"); + push(@args, "rest_args"); } } pop(@code); # Get rid of 'commit' instruction my $index = tr_next_index(\@call_table, \%call_table, $name, @args); - push(@code, make_op("$name()", 'call_end', $index)); + my $op = make_op("$name()", 'call_end', $index); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); last; } @@ -1725,11 +1665,13 @@ sub tr_gen_to { my($var, $type, $type_val) = @$op; if ($type eq '*') { - push(@code, make_op($var, 'store_rest_args', $var{$var})); + push(@code, make_op($var, 'store_rest_args')); } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); + my $op = make_op($var, 'store_var_next_arg', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { @@ -1744,6 +1686,10 @@ sub tr_gen_to { push(@code, make_op('', 'end')) unless is_instr($code[$#code], 'call_end'); + tr_maybe_keep(\@code); + tr_maybe_rename(\@code); + tr_remove_unused(\@code); + # # Chain together all codes segments having the same first operation. # @@ -1752,8 +1698,6 @@ sub tr_gen_to { my($dummy, $arity); ($dummy, $op, $arity) = @$first; my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; - $min_window{$key} = $min_window - if $min_window{$key} > $min_window; my $prev_last; $prev_last = pop(@{$gen_transform{$key}}) @@ -1771,6 +1715,148 @@ sub tr_gen_to { push(@{$gen_transform{$key}}, @code), } +sub tr_maybe_keep { + my($ref) = @_; + my @last_instr; + my $pos; + my $reused_instr; + + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'next_instr') { + @last_instr = ($args[0]); + } elsif ($op eq 'set_var_next_arg') { + push @last_instr, $args[0]; + } elsif ($op eq 'next_arg') { + push @last_instr, 'ignored'; + } elsif ($op eq 'new_instr') { + unless (defined $pos) { + # 'new_instr' immediately after 'commit'. + $reused_instr = $args[0]; + return unless shift(@last_instr) == $reused_instr; + $pos = $i - 1; + } else { + # Second 'new_instr' after 'commit'. The instructions + # from $pos up to and including $i - 1 rebuilds the + # existing instruction exactly. + my $name = $gen_opname[$reused_instr]; + my $arity = $gen_arity[$reused_instr]; + my $reuse = make_op("$name/$arity", 'keep'); + splice @$ref, $pos, $i-$pos, ($reuse); + return; + } + } elsif ($op eq 'store_var_next_arg') { + return unless shift(@last_instr) eq $args[0]; + } elsif (defined $pos) { + return; + } + } +} + +sub tr_maybe_rename { + my($ref) = @_; + my $s = 'left'; + my $a = 0; + my $num_args = 0; + my $new_instr; + my $first; + my $i; + + for ($i = 1; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + + if ($s eq 'left') { + if ($op eq 'set_var_next_arg') { + if ($num_args == $a and $args[0] == $a) { + $num_args++; + } + $a++; + } elsif ($op eq 'next_arg') { + $a++; + } elsif ($op eq 'commit') { + $a = 0; + $first = $i; + $s = 'committed'; + } elsif ($op eq 'next_instr') { + return; + } + } elsif ($s eq 'committed') { + if ($op eq 'new_instr') { + $new_instr = $args[0]; + $a = 0; + $s = 'right'; + } else { + return; + } + } elsif ($s eq 'right') { + if ($op eq 'store_var_next_arg' && $args[0] == $a) { + $a++; + } elsif ($op eq 'end' && $a <= $num_args) { + my $name = $gen_opname[$new_instr]; + my $arity = $gen_arity[$new_instr]; + my $new_op = make_op("$name/$arity", 'rename', $new_instr); + splice @$ref, $first, $i-$first+1, ($new_op); + return; + } else { + return; + } + } + } +} + +sub tr_remove_unused { + my($ref) = @_; + my %used; + + # Collect all used variables. + for my $instr (@$ref) { + my $uref = $$instr[3]; + for my $slot (@$uref) { + $used{$slot} = 1; + } + } + + # Replace 'set_var_next_arg' with 'next_arg' if the variable + # is never used. + for my $instr (@$ref) { + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'set_var_next_arg') { + my $var = $args[0]; + next if $used{$var}; + $instr = make_op("$comment (ignored)", 'next_arg'); + } + } + + # Delete a sequence of 'next_arg' instructions when they are + # redundant before instructions such as 'commit'. + my @opcode; + my %ending = (call_end => 1, + commit => 1, + next_instr => 1, + pred => 1, + rename => 1, + keep => 1); + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($opcode) = @$instr_ref; + + if ($ending{$opcode}) { + my $first = $i; + $first-- while $first > 0 and $opcode[$first-1] eq 'next_arg'; + my $n = $i - $first; + splice @$ref, $first, $n; + $i -= $n; + } + $opcode[$i] = $opcode; + } +} + sub tr_code_len { my($sum) = 0; my($ref); @@ -1783,7 +1869,12 @@ sub tr_code_len { sub make_op { my($comment, @op) = @_; - [scalar(@op), [@op], $comment]; + [scalar(@op), [@op], $comment, []]; +} + +sub op_slot_usage { + my($op_ref, @slots) = @_; + $$op_ref[3] = \@slots; } sub is_instr { diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index e127eff097..98a7404cfe 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -237,8 +237,8 @@ static const struct in6_addr in6addr_loopback = #define EPMD_TRUE 1 /* If no activity we let select() return every IDLE_TIMEOUT second - A file descriptor that are idle for CLOSE_TIMEOUT seconds and - isn't a ALIVE socket is probably hanging and we close it */ + A file descriptor that has been idle for CLOSE_TIMEOUT seconds and + isn't an ALIVE socket has probably hanged and should be closed */ #define IDLE_TIMEOUT 5 #define CLOSE_TIMEOUT 60 diff --git a/erts/etc/common/ct_run.c b/erts/etc/common/ct_run.c index 548514ee6c..03ab22d1a1 100644 --- a/erts/etc/common/ct_run.c +++ b/erts/etc/common/ct_run.c @@ -81,13 +81,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -141,10 +142,10 @@ int main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -334,7 +335,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -437,15 +438,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c index c45626606c..8ee2db7e3f 100644 --- a/erts/etc/common/dialyzer.c +++ b/erts/etc/common/dialyzer.c @@ -63,13 +63,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -164,10 +165,10 @@ int main(int argc, char** argv) #ifdef __WIN32__ int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -310,7 +311,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -413,15 +414,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c index f9d909e01c..08ac40f947 100644 --- a/erts/etc/common/erlc.c +++ b/erts/etc/common/erlc.c @@ -71,13 +71,14 @@ static int pause_after_execution = 0; static char* process_opt(int* pArgc, char*** pArgv, int offset); static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -171,10 +172,10 @@ int main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -370,7 +371,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -478,15 +479,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c index 7fd02ed436..ce53e77cee 100644 --- a/erts/etc/common/escript.c +++ b/erts/etc/common/escript.c @@ -71,7 +71,7 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static void efree(void *p); static char* strsave(char* string); static void push_words(char* src); @@ -79,6 +79,7 @@ static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -418,10 +419,10 @@ main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -594,7 +595,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -694,15 +695,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static void efree(void *p) { diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c index e298c5e7f7..b27c3da9ac 100644 --- a/erts/etc/common/inet_gethost.c +++ b/erts/etc/common/inet_gethost.c @@ -2646,7 +2646,7 @@ static void *my_realloc(void *old, size_t size) BOOL create_mesq(MesQ **q) { - MesQ *tmp = malloc(sizeof(MesQ)); + MesQ *tmp = ALLOC(sizeof(MesQ)); tmp->data_present = CreateEvent(NULL, TRUE, FALSE,NULL); if (tmp->data_present == NULL) { free(tmp); diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c index 0aa0996808..7f08050cc6 100644 --- a/erts/etc/common/typer.c +++ b/erts/etc/common/typer.c @@ -63,13 +63,14 @@ static int eargc; /* Number of arguments in eargv. */ */ static void error(char* format, ...); -static char* emalloc(size_t size); +static void* emalloc(size_t size); static char* strsave(char* string); static void push_words(char* src); static int run_erlang(char* name, char** argv); static char* get_default_emulator(char* progname); #ifdef __WIN32__ static char* possibly_quote(char* arg); +static void* erealloc(void *p, size_t size); #endif /* @@ -118,10 +119,10 @@ main(int argc, char** argv) int i; int len; /* Convert argv to utf8 */ - argv = malloc((argc+1) * sizeof(char*)); + argv = emalloc((argc+1) * sizeof(char*)); for (i=0; i<argc; i++) { len = WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, NULL, 0, NULL, NULL); - argv[i] = malloc(len*sizeof(char)); + argv[i] = emalloc(len*sizeof(char)); WideCharToMultiByte(CP_UTF8, 0, wcargv[i], -1, argv[i], len, NULL, NULL); } argv[argc] = NULL; @@ -232,7 +233,7 @@ wchar_t *make_commandline(char **argv) buff = (wchar_t *) emalloc(siz*sizeof(wchar_t)); } else if (siz < num) { siz = num; - buff = (wchar_t *) realloc(buff,siz*sizeof(wchar_t)); + buff = (wchar_t *) erealloc(buff,siz*sizeof(wchar_t)); } p = buff; num=0; @@ -332,15 +333,26 @@ error(char* format, ...) exit(1); } -static char* +static void* emalloc(size_t size) { - char *p = malloc(size); + void *p = malloc(size); if (p == NULL) error("Insufficient memory"); return p; } +#ifdef __WIN32__ +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +#endif + static char* strsave(char* string) { diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam Binary files differindex 2ea2de4c70..7ceb6daaa3 100644 --- a/erts/preloaded/ebin/erlang.beam +++ b/erts/preloaded/ebin/erlang.beam diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl index dfbd116d6e..50b01703ac 100644 --- a/erts/preloaded/src/erlang.erl +++ b/erts/preloaded/src/erlang.erl @@ -2130,7 +2130,7 @@ process_flag(_Flag, _Value) -> {message_queue_data, MQD :: message_queue_data()} | {priority, Level :: priority_level()} | {reductions, Number :: non_neg_integer()} | - {registered_name, Atom :: atom()} | + {registered_name, [] | (Atom :: atom())} | {sequential_trace_token, [] | (SequentialTraceToken :: term())} | {stack_size, Size :: non_neg_integer()} | {status, Status :: exiting | garbage_collecting | waiting | running | runnable | suspended} | diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl index f0fee49024..f68a85b3e5 100644 --- a/erts/test/erl_print_SUITE.erl +++ b/erts/test/erl_print_SUITE.erl @@ -28,153 +28,133 @@ -module(erl_print_SUITE). -author('[email protected]'). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -%-define(line_trace, 1). - --define(DEFAULT_TIMEOUT, ?t:minutes(10)). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). - --export([erlang_display/1, integer/1, float/1, - string/1, character/1, snprintf/1, quote/1]). +-export([erlang_display/1, integer/1, float/1, + string/1, character/1, snprintf/1, quote/1]). -include_lib("common_test/include/ct.hrl"). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> - test_cases(). - -groups() -> - []. + [erlang_display, integer, float, string, character, + snprintf, quote]. -init_per_suite(Config) -> - Config. +init_per_testcase(Case, Config) -> + [{testcase, Case}|Config]. -end_per_suite(_Config) -> +end_per_testcase(_Case, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% %% %% Test cases %% %% -test_cases() -> - [erlang_display, integer, float, string, character, - snprintf, quote]. - -erlang_display(doc) -> []; -erlang_display(suite) -> []; erlang_display(Config) when is_list(Config) -> - ?line put(erlang_display_test, ok), + put(erlang_display_test, ok), OAIS = erts_debug:set_internal_state(available_internal_state, true), %% atoms - ?line chk_display(atom, "atom"), - ?line chk_display(true, "true"), - ?line chk_display(false, "false"), - ?line chk_display('DOWN', "'DOWN'"), - ?line chk_display('EXIT', "'EXIT'"), - ?line chk_display('asdDofw $@{}][', "'asdDofw $@{}]['"), + chk_display(atom, "atom"), + chk_display(true, "true"), + chk_display(false, "false"), + chk_display('DOWN', "'DOWN'"), + chk_display('EXIT', "'EXIT'"), + chk_display('asdDofw $@{}][', "'asdDofw $@{}]['"), %% integers - ?line chk_display(0, "0"), - ?line chk_display(1, "1"), - ?line chk_display(4711, "4711"), - ?line chk_display(((1 bsl 27) - 1), "134217727"), - ?line chk_display((1 bsl 27), "134217728"), - ?line chk_display((1 bsl 32), "4294967296"), - ?line chk_display(11111111111, "11111111111"), - ?line chk_display((1 bsl 59) - 1, "576460752303423487"), - ?line chk_display(1 bsl 59, "576460752303423488"), - ?line chk_display(111111111111111111111, "111111111111111111111"), - ?line chk_display(123456789012345678901234567890, - "123456789012345678901234567890"), - ?line chk_display(1 bsl 10000, str_1_bsl_10000()), - ?line chk_display(-1, "-1"), - ?line chk_display(-4711, "-4711"), - ?line chk_display(-(1 bsl 27), "-134217728"), - ?line chk_display(-((1 bsl 27) + 1), "-134217729"), - ?line chk_display(-(1 bsl 32), "-4294967296"), - ?line chk_display(-11111111111, "-11111111111"), - ?line chk_display(-(1 bsl 59), "-576460752303423488"), - ?line chk_display(-((1 bsl 59) + 1), "-576460752303423489"), - ?line chk_display(-111111111111111111111, "-111111111111111111111"), - ?line chk_display(-123456789012345678901234567890, - "-123456789012345678901234567890"), - ?line chk_display(-(1 bsl 10000), [$- | str_1_bsl_10000()]), - - ?line MyCre = my_cre(), + chk_display(0, "0"), + chk_display(1, "1"), + chk_display(4711, "4711"), + chk_display(((1 bsl 27) - 1), "134217727"), + chk_display((1 bsl 27), "134217728"), + chk_display((1 bsl 32), "4294967296"), + chk_display(11111111111, "11111111111"), + chk_display((1 bsl 59) - 1, "576460752303423487"), + chk_display(1 bsl 59, "576460752303423488"), + chk_display(111111111111111111111, "111111111111111111111"), + chk_display(123456789012345678901234567890, + "123456789012345678901234567890"), + chk_display(1 bsl 10000, str_1_bsl_10000()), + chk_display(-1, "-1"), + chk_display(-4711, "-4711"), + chk_display(-(1 bsl 27), "-134217728"), + chk_display(-((1 bsl 27) + 1), "-134217729"), + chk_display(-(1 bsl 32), "-4294967296"), + chk_display(-11111111111, "-11111111111"), + chk_display(-(1 bsl 59), "-576460752303423488"), + chk_display(-((1 bsl 59) + 1), "-576460752303423489"), + chk_display(-111111111111111111111, "-111111111111111111111"), + chk_display(-123456789012345678901234567890, + "-123456789012345678901234567890"), + chk_display(-(1 bsl 10000), [$- | str_1_bsl_10000()]), + + MyCre = my_cre(), %% pids - ?line chk_display(mk_pid_xstr({node(), MyCre}, 4711, 42)), - ?line chk_display(mk_pid_xstr({node(), oth_cre(MyCre)}, 4711, 42)), - ?line chk_display(mk_pid_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711, 42)), + chk_display(mk_pid_xstr({node(), MyCre}, 4711, 42)), + chk_display(mk_pid_xstr({node(), oth_cre(MyCre)}, 4711, 42)), + chk_display(mk_pid_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, MyCre}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, oth_cre(MyCre)}, 4711, 42)), - ?line chk_display(mk_pid_xstr({a@b, oth_cre(oth_cre(MyCre))}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, MyCre}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, oth_cre(MyCre)}, 4711, 42)), + chk_display(mk_pid_xstr({a@b, oth_cre(oth_cre(MyCre))}, 4711, 42)), %% ports - ?line chk_display(mk_port_xstr({node(), MyCre}, 4711)), - ?line chk_display(mk_port_xstr({node(), oth_cre(MyCre)}, 4711)), - ?line chk_display(mk_port_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711)), + chk_display(mk_port_xstr({node(), MyCre}, 4711)), + chk_display(mk_port_xstr({node(), oth_cre(MyCre)}, 4711)), + chk_display(mk_port_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711)), - ?line chk_display(mk_port_xstr({c@d, MyCre}, 4711)), - ?line chk_display(mk_port_xstr({c@d, oth_cre(MyCre)}, 4711)), - ?line chk_display(mk_port_xstr({c@d, oth_cre(oth_cre(MyCre))}, 4711)), + chk_display(mk_port_xstr({c@d, MyCre}, 4711)), + chk_display(mk_port_xstr({c@d, oth_cre(MyCre)}, 4711)), + chk_display(mk_port_xstr({c@d, oth_cre(oth_cre(MyCre))}, 4711)), %% refs - ?line chk_display(mk_ref_xstr({node(), MyCre}, [1,2,3])), - ?line chk_display(mk_ref_xstr({node(), oth_cre(MyCre)}, [1,2,3])), - ?line chk_display(mk_ref_xstr({node(), oth_cre(oth_cre(MyCre))}, [1,2,3])), + chk_display(mk_ref_xstr({node(), MyCre}, [1,2,3])), + chk_display(mk_ref_xstr({node(), oth_cre(MyCre)}, [1,2,3])), + chk_display(mk_ref_xstr({node(), oth_cre(oth_cre(MyCre))}, [1,2,3])), - ?line chk_display(mk_ref_xstr({e@f, MyCre},[1,2,3] )), - ?line chk_display(mk_ref_xstr({e@f, oth_cre(MyCre)}, [1,2,3])), - ?line chk_display(mk_ref_xstr({e@f, oth_cre(oth_cre(MyCre))}, [1,2,3])), + chk_display(mk_ref_xstr({e@f, MyCre},[1,2,3] )), + chk_display(mk_ref_xstr({e@f, oth_cre(MyCre)}, [1,2,3])), + chk_display(mk_ref_xstr({e@f, oth_cre(oth_cre(MyCre))}, [1,2,3])), %% Compund terms - ?line {Pid, PidStr} = mk_pid_xstr({x@y, oth_cre(MyCre)}, 4712, 41), - ?line {Port, PortStr} = mk_port_xstr({x@y, oth_cre(MyCre)}, 4712), - ?line {Ref, RefStr} = mk_ref_xstr({e@f, oth_cre(MyCre)}, [11,12,13]), - - ?line chk_display({atom,-4711,Ref,{"hej",[Pid,222222222222222222222222,Port,4711]}}, - "{atom,-4711,"++RefStr++",{\"hej\",["++PidStr++",222222222222222222222222,"++PortStr++",4711]}}"), - ?line chk_display({{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}, - "{{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}"), - ?line chk_display([[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]], - "[[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]]"), - ?line chk_display({[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}, - "{[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}"), - ?line chk_display([], "[]"), % Not really a compound term :) - ?line chk_display([a|b], "[a|b]"), - ?line chk_display([a,b,c|z], "[a,b,c|z]"), - ?line chk_display([a,b,c], "[a,b,c]"), - ?line chk_display([Pid,Port,Ref], - "["++PidStr++","++PortStr++","++RefStr++"]"), - ?line chk_display("abcdefghijklmnopqrstuvwxyz", - "\"abcdefghijklmnopqrstuvwxyz\""), - ?line chk_display("ABCDEFGHIJKLMNOPQRSTUVWXYZ", - "\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\""), - ?line chk_display("H E J", "\"H E J\""), - ?line chk_display("asdDofw $@{}][", "\"asdDofw $@{}][\""), - + {Pid, PidStr} = mk_pid_xstr({x@y, oth_cre(MyCre)}, 4712, 41), + {Port, PortStr} = mk_port_xstr({x@y, oth_cre(MyCre)}, 4712), + {Ref, RefStr} = mk_ref_xstr({e@f, oth_cre(MyCre)}, [11,12,13]), + + chk_display({atom,-4711,Ref,{"hej",[Pid,222222222222222222222222,Port,4711]}}, + "{atom,-4711,"++RefStr++",{\"hej\",["++PidStr++",222222222222222222222222,"++PortStr++",4711]}}"), + chk_display({{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}, + "{{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}"), + chk_display([[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]], + "[[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]]"), + chk_display({[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}, + "{[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}"), + chk_display([], "[]"), % Not really a compound term :) + chk_display([a|b], "[a|b]"), + chk_display([a,b,c|z], "[a,b,c|z]"), + chk_display([a,b,c], "[a,b,c]"), + chk_display([Pid,Port,Ref], + "["++PidStr++","++PortStr++","++RefStr++"]"), + chk_display("abcdefghijklmnopqrstuvwxyz", + "\"abcdefghijklmnopqrstuvwxyz\""), + chk_display("ABCDEFGHIJKLMNOPQRSTUVWXYZ", + "\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\""), + chk_display("H E J", "\"H E J\""), + chk_display("asdDofw $@{}][", "\"asdDofw $@{}][\""), + %% %% TODO: Check binaries, fun and floats... %% erts_debug:set_internal_state(available_internal_state, OAIS), - ?line ok = get(erlang_display_test). + ok = get(erlang_display_test). get_chnl_no(NodeName) when is_atom(NodeName) -> erts_debug:get_internal_state({channel_number, NodeName}). @@ -182,20 +162,20 @@ get_chnl_no(NodeName) when is_atom(NodeName) -> chk_display(Term, Expect) when is_list(Expect) -> Dstr = erts_debug:display(Term), case Expect ++ io_lib:nl() of - Dstr -> - ?t:format("Test of \"~p\" succeeded.~n" - " Expected and got: ~s~n", - [Term, io_lib:write_string(Dstr)]); - DoExpect -> - ?t:format("***~n" - "*** Test of \"~p\" failed!~n" - "*** Expected: ~s~n" - "*** Got: ~s~n" - "***~n", - [Term, - io_lib:write_string(DoExpect), - io_lib:write_string(Dstr)]), - put(erlang_display_test, failed) + Dstr -> + io:format("Test of \"~p\" succeeded.~n" + " Expected and got: ~s~n", + [Term, io_lib:write_string(Dstr)]); + DoExpect -> + io:format("***~n" + "*** Test of \"~p\" failed!~n" + "*** Expected: ~s~n" + "*** Got: ~s~n" + "***~n", + [Term, + io_lib:write_string(DoExpect), + io_lib:write_string(Dstr)]), + put(erlang_display_test, failed) end. chk_display({Term, Expect}) -> @@ -204,20 +184,20 @@ chk_display({Term, Expect}) -> mk_pid_xstr({NodeName, Creation}, Number, Serial) -> Pid = mk_pid({NodeName, Creation}, Number, Serial), XStr = "<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ "." ++ integer_to_list(Number) - ++ "." ++ integer_to_list(Serial) ++ ">", + ++ "." ++ integer_to_list(Number) + ++ "." ++ integer_to_list(Serial) ++ ">", {Pid, XStr}. mk_port_xstr({NodeName, Creation}, Number) -> Port = mk_port({NodeName, Creation}, Number), XStr = "#Port<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ "." ++ integer_to_list(Number) ++ ">", + ++ "." ++ integer_to_list(Number) ++ ">", {Port, XStr}. mk_ref_xstr({NodeName, Creation}, Numbers) -> Ref = mk_ref({NodeName, Creation}, Numbers), XStr = "#Ref<" ++ integer_to_list(get_chnl_no(NodeName)) - ++ ref_numbers_xstr(Numbers) ++ ">", + ++ ref_numbers_xstr(Numbers) ++ ">", {Ref, XStr}. ref_numbers_xstr([]) -> @@ -240,18 +220,7 @@ ref_numbers_xstr([N | Ns]) -> %% %% -default_testcase_impl(doc) -> []; -default_testcase_impl(suite) -> []; -default_testcase_impl(Config) when is_list(Config) -> ?line run_case(Config). - -init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case}, {watchdog, Dog} |Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. +default_testcase_impl(Config) when is_list(Config) -> run_case(Config). -define(TESTPROG, "erl_print_tests"). -define(FAILED_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). @@ -260,62 +229,62 @@ end_per_testcase(_Case, Config) -> -define(PID_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$P,$I,$D). port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> - ?line process_flag(trap_exit, true), - ?line Ref = erlang:monitor(process, EProc), - ?line receive - {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), - element(1, Reason) - == timetrap_timeout -> - ?line Cmd = "kill -9 " ++ OSProc, - ?line ?t:format("Test case timed out. " - "Trying to kill port program.~n" - " Executing: ~p~n", [Cmd]), - ?line case os:cmd(Cmd) of - [] -> - ok; - OsCmdRes -> - ?line ?t:format(" ~s", [OsCmdRes]) - end; - {'DOWN', Ref, _, _, _} -> - %% OSProc is assumed to have terminated by itself - ?line ok - end. + process_flag(trap_exit, true), + Ref = erlang:monitor(process, EProc), + receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + Cmd = "kill -9 " ++ OSProc, + io:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + io:format(" ~s", [OsCmdRes]) + end; + {'DOWN', Ref, _, _, _} -> + %% OSProc is assumed to have terminated by itself + ok + end. get_line(_Port, eol, Data) -> - ?line Data; + Data; get_line(Port, noeol, Data) -> - ?line receive - {Port, {data, {Flag, NextData}}} -> - ?line get_line(Port, Flag, Data ++ NextData); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {Flag, NextData}}} -> + get_line(Port, Flag, Data ++ NextData); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. read_case_data(Port, TestCase) -> - ?line receive - {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> - ?line ok; - {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> - ?line {comment, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> - ?line {skipped, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> - ?line ?t:fail(get_line(Port, Flag, ReasonStart)); - {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> - ?line ?t:format("Port program pid: ~s~n", [PidStr]), - ?line CaseProc = self(), - ?line _ = list_to_integer(PidStr), % Sanity check - spawn_opt(fun () -> - port_prog_killer(CaseProc, PidStr) - end, - [{priority, max}, link]), - read_case_data(Port, TestCase); - {Port, {data, {Flag, LineStart}}} -> - ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), - read_case_data(Port, TestCase); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ct:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + io:format("Port program pid: ~s~n", [PidStr]), + CaseProc = self(), + _ = list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + io:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. run_case(Config) -> run_case(Config, ""). @@ -324,27 +293,27 @@ run_case(Config, TestArgs) -> run_case(Config, TestArgs, fun (_Port) -> ok end). run_case(Config, TestArgs, Fun) -> - Test = atom_to_list(?config(testcase, Config)), - TestProg = filename:join([?config(data_dir, Config), - ?TESTPROG - ++ "." - ++ atom_to_list(erlang:system_info(threads))]), + Test = atom_to_list(proplists:get_value(testcase, Config)), + TestProg = filename:join([proplists:get_value(data_dir, Config), + ?TESTPROG + ++ "." + ++ atom_to_list(erlang:system_info(threads))]), Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, case catch open_port({spawn, Cmd}, [stream, - use_stdio, - stderr_to_stdout, - eof, - {line, 1024}]) of - Port when is_port(Port) -> - ?line Fun(Port), - ?line CaseResult = read_case_data(Port, Test), - ?line receive - {Port, eof} -> - ?line ok - end, - ?line CaseResult; - Error -> - ?line ?t:fail({open_port_failed, Error}) + use_stdio, + stderr_to_stdout, + eof, + {line, 1024}]) of + Port when is_port(Port) -> + Fun(Port), + CaseResult = read_case_data(Port, Test), + receive + {Port, eof} -> + ok + end, + CaseResult; + Error -> + ct:fail({open_port_failed, Error}) end. @@ -382,80 +351,80 @@ mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); mk_pid({NodeName, Creation}, Number, Serial) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PID_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint32_be(Serial), - uint8(Creation)])) of - Pid when is_pid(Pid) -> - Pid; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PID_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> mk_port({atom_to_list(NodeName), Creation}, Number); mk_port({NodeName, Creation}, Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?PORT_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Port when is_port(Port) -> - Port; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_port, [{NodeName, Creation}, Number]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?PORT_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeName, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> mk_ref({atom_to_list(NodeName), Creation}, Numbers); mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), - is_integer(Creation), - is_integer(Number) -> + is_integer(Creation), + is_integer(Number) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?REFERENCE_EXT, - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint32_be(Number), - uint8(Creation)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end; mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), - is_integer(Creation), - is_list(Numbers) -> + is_integer(Creation), + is_list(Numbers) -> case catch binary_to_term(list_to_binary([?VERSION_MAGIC, - ?NEW_REFERENCE_EXT, - uint16_be(length(Numbers)), - ?ATOM_EXT, - uint16_be(length(NodeName)), - NodeName, - uint8(Creation), - lists:map(fun (N) -> - uint32_be(N) - end, - Numbers)])) of - Ref when is_reference(Ref) -> - Ref; - {'EXIT', {badarg, _}} -> - exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); - Other -> - exit({unexpected_binary_to_term_result, Other}) + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) end. my_cre() -> erlang:system_info(creation). diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index 7e44be1fe0..0750bf2836 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -22,10 +22,10 @@ %% Tests the erlc command by compiling various types of files. -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, compile_erl/1, - compile_yecc/1, compile_script/1, - compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1, - make_dep_options/1]). + init_per_group/2,end_per_group/2, compile_erl/1, + compile_yecc/1, compile_script/1, + compile_mib/1, good_citizen/1, deep_cwd/1, arg_overflow/1, + make_dep_options/1]). -include_lib("common_test/include/ct.hrl"). @@ -57,113 +57,109 @@ end_per_group(_GroupName, Config) -> %% Tests that compiling Erlang source code works. compile_erl(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "erl_test_ok.erl"), %% By default, warnings are now turned on. - ?line run(Config, Cmd, FileName, "", - ["Warning: function foo/0 is unused\$", - "_OK_"]), + run(Config, Cmd, FileName, "", + ["Warning: function foo/0 is unused\$", "_OK_"]), %% Test that the compiled file is where it should be, %% and that it is runnable. - ?line {module, erl_test_ok} = code:load_abs(filename:join(OutDir, - "erl_test_ok")), - ?line 42 = erl_test_ok:shoe_size(#person{shoe_size=42}), - ?line code:purge(erl_test_ok), + {module, erl_test_ok} = code:load_abs(filename:join(OutDir, "erl_test_ok")), + 42 = erl_test_ok:shoe_size(#person{shoe_size=42}), + code:purge(erl_test_ok), %% Try disabling warnings. - ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), + run(Config, Cmd, FileName, "-W0", ["_OK_"]), %% Try treating warnings as errors. - ?line run(Config, Cmd, FileName, "-Werror", - ["compile: warnings being treated as errors\$", - "function foo/0 is unused\$", - "_ERROR_"]), + run(Config, Cmd, FileName, "-Werror", + ["compile: warnings being treated as errors\$", + "function foo/0 is unused\$", "_ERROR_"]), %% Check a bad file. - ?line BadFile = filename:join(SrcDir, "erl_test_bad.erl"), - ?line run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", - "_ERROR_"]), + BadFile = filename:join(SrcDir, "erl_test_bad.erl"), + run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", + "_ERROR_"]), ok. %% Test that compiling yecc source code works. compile_yecc(Config) when is_list(Config) -> - ?line {SrcDir, _, OutDir} = get_dirs(Config), - ?line Cmd = erlc() ++ " -o" ++ OutDir ++ " ", - ?line FileName = filename:join(SrcDir, "yecc_test_ok.yrl"), - ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), - ?line true = exists(filename:join(OutDir, "yecc_test_ok.erl")), - - ?line BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), - ?line run(Config, Cmd, BadFile, "-W0", - ["rootsymbol form is not a nonterminal\$", - "undefined nonterminal: form\$", - "Nonterminals is missing\$", - "_ERROR_"]), - ?line exists(filename:join(OutDir, "yecc_test_ok.erl")), - + {SrcDir, _, OutDir} = get_dirs(Config), + Cmd = erlc() ++ " -o" ++ OutDir ++ " ", + FileName = filename:join(SrcDir, "yecc_test_ok.yrl"), + run(Config, Cmd, FileName, "-W0", ["_OK_"]), + true = exists(filename:join(OutDir, "yecc_test_ok.erl")), + + BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), + run(Config, Cmd, BadFile, "-W0", + ["rootsymbol form is not a nonterminal\$", + "undefined nonterminal: form\$", + "Nonterminals is missing\$", + "_ERROR_"]), + exists(filename:join(OutDir, "yecc_test_ok.erl")), ok. %% Test that compiling start scripts works. compile_script(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "start_ok.script"), - ?line run(Config, Cmd, FileName, "", ["_OK_"]), - ?line true = exists(filename:join(OutDir, "start_ok.boot")), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "start_ok.script"), + run(Config, Cmd, FileName, "", ["_OK_"]), + true = exists(filename:join(OutDir, "start_ok.boot")), - ?line BadFile = filename:join(SrcDir, "start_bad.script"), - ?line run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), + BadFile = filename:join(SrcDir, "start_bad.script"), + run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), ok. %% Test that compiling SNMP mibs works. compile_mib(Config) when is_list(Config) -> - ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "GOOD-MIB.mib"), - ?line run(Config, Cmd, FileName, "", ["_OK_"]), - ?line Output = filename:join(OutDir, "GOOD-MIB.bin"), - ?line true = exists(Output), + {SrcDir, OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "GOOD-MIB.mib"), + run(Config, Cmd, FileName, "", ["_OK_"]), + Output = filename:join(OutDir, "GOOD-MIB.bin"), + true = exists(Output), %% Try -W option. - ?line ok = file:delete(Output), - ?line run(Config, Cmd, FileName, "-W", - ["_OK_"]), - ?line true = exists(Output), + ok = file:delete(Output), + run(Config, Cmd, FileName, "-W", + ["_OK_"]), + true = exists(Output), %% Try -W option and more verbose. - ?line ok = file:delete(Output), - ?line case test_server:os_type() of - {unix,_} -> - ?line run(Config, Cmd, FileName, "-W +'{verbosity,info}'", - ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", - "_OK_"]), - ?line true = exists(Output), - ?line ok = file:delete(Output); - _ -> ok %Don't bother -- too much work. - end, + ok = file:delete(Output), + case test_server:os_type() of + {unix,_} -> + run(Config, Cmd, FileName, "-W +'{verbosity,info}'", + ["\\[GOOD-MIB[.]mib\\]\\[INF\\]: No accessfunction for 'sysDescr' => using default", + "_OK_"]), + true = exists(Output), + ok = file:delete(Output); + _ -> ok %Don't bother -- too much work. + end, %% Try a bad file. - ?line BadFile = filename:join(SrcDir, "BAD-MIB.mib"), - ?line run(Config, Cmd, BadFile, "", - ["BAD-MIB.mib: 1: syntax error before: mibs\$", - "compilation_failed_ERROR_"]), + BadFile = filename:join(SrcDir, "BAD-MIB.mib"), + run(Config, Cmd, BadFile, "", + ["BAD-MIB.mib: 1: syntax error before: mibs\$", + "compilation_failed_ERROR_"]), %% Make sure that no -I option works. - ?line NewCmd = erlc() ++ " -o" ++ OutDir ++ " ", - ?line run(Config, NewCmd, FileName, "", ["_OK_"]), - ?line true = exists(Output), + NewCmd = erlc() ++ " -o" ++ OutDir ++ " ", + run(Config, NewCmd, FileName, "", ["_OK_"]), + true = exists(Output), ok. @@ -171,91 +167,91 @@ compile_mib(Config) when is_list(Config) -> %% shell script with redirected input). good_citizen(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - ?line PrivDir = ?config(priv_dir, Config), - ?line Answer = filename:join(PrivDir, "answer"), - ?line Script = filename:join(PrivDir, "test_script"), - ?line Test = filename:join(PrivDir, "test.erl"), - ?line S = ["#! /bin/sh\n", "erlc ", Test, "\n", - "read reply\n", "echo $reply\n"], - ?line ok = file:write_file(Script, S), - ?line ok = file:write_file(Test, "-module(test).\n"), - ?line Cmd = "echo y | sh " ++ Script ++ " > " ++ Answer, - ?line os:cmd(Cmd), - ?line {ok, Answer0} = file:read_file(Answer), - ?line [$y|_] = binary_to_list(Answer0), - ok; - _ -> - {skip, "Unix specific"} + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + Answer = filename:join(PrivDir, "answer"), + Script = filename:join(PrivDir, "test_script"), + Test = filename:join(PrivDir, "test.erl"), + S = ["#! /bin/sh\n", "erlc ", Test, "\n", + "read reply\n", "echo $reply\n"], + ok = file:write_file(Script, S), + ok = file:write_file(Test, "-module(test).\n"), + Cmd = "echo y | sh " ++ Script ++ " > " ++ Answer, + os:cmd(Cmd), + {ok, Answer0} = file:read_file(Answer), + [$y|_] = binary_to_list(Answer0), + ok; + _ -> + {skip, "Unix specific"} end. %% Make sure that compiling an Erlang module deep down in %% in a directory with more than 255 characters works. deep_cwd(Config) when is_list(Config) -> case os:type() of - {unix, _} -> - PrivDir = ?config(priv_dir, Config), - deep_cwd_1(PrivDir); - _ -> - {skip, "Only a problem on Unix"} + {unix, _} -> + PrivDir = proplists:get_value(priv_dir, Config), + deep_cwd_1(PrivDir); + _ -> + {skip, "Only a problem on Unix"} end. deep_cwd_1(PrivDir) -> - ?line DeepDir0 = filename:join(PrivDir, lists:duplicate(128, $a)), - ?line DeepDir = filename:join(DeepDir0, lists:duplicate(128, $b)), - ?line ok = file:make_dir(DeepDir0), - ?line ok = file:make_dir(DeepDir), - ?line ok = file:set_cwd(DeepDir), - ?line ok = file:write_file("test.erl", "-module(test).\n\n"), - ?line io:format("~s\n", [os:cmd("erlc test.erl")]), - ?line true = filelib:is_file("test.beam"), + DeepDir0 = filename:join(PrivDir, lists:duplicate(128, $a)), + DeepDir = filename:join(DeepDir0, lists:duplicate(128, $b)), + ok = file:make_dir(DeepDir0), + ok = file:make_dir(DeepDir), + ok = file:set_cwd(DeepDir), + ok = file:write_file("test.erl", "-module(test).\n\n"), + io:format("~s\n", [os:cmd("erlc test.erl")]), + true = filelib:is_file("test.beam"), ok. %% Test that a large number of command line switches does not %% overflow the argument buffer arg_overflow(Config) when is_list(Config) -> - ?line {SrcDir, _OutDir, Cmd} = get_cmd(Config), - ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), + {SrcDir, _OutDir, Cmd} = get_cmd(Config), + FileName = filename:join(SrcDir, "erl_test_ok.erl"), %% Each -D option will be expanded to three arguments when %% invoking 'erl'. - ?line NumDOptions = num_d_options(), - ?line Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || - N <- lists:seq(1, NumDOptions) ]), - ?line run(Config, Cmd, FileName, Args, - ["Warning: function foo/0 is unused\$", - "_OK_"]), + NumDOptions = num_d_options(), + Args = lists:flatten([ ["-D", integer_to_list(N, 36), "=1 "] || + N <- lists:seq(1, NumDOptions) ]), + run(Config, Cmd, FileName, Args, + ["Warning: function foo/0 is unused\$", + "_OK_"]), ok. num_d_options() -> case {os:type(),os:version()} of - {{win32,_},_} -> - %% The maximum size of a command line in the command - %% shell on Windows is 8191 characters. - %% Each -D option is expanded to "@dv NN 1", i.e. - %% 8 characters. (Numbers up to 1295 can be expressed - %% as two 36-base digits.) - 1000; - {{unix,linux},Version} when Version < {2,6,23} -> - %% On some older 64-bit versions of Linux, the maximum number - %% of arguments is 16383. - %% See: http://www.in-ulm.de/~mascheck/various/argmax/ - 5440; - {{unix,darwin},{Major,_,_}} when Major >= 11 -> - %% "getconf ARG_MAX" still reports 262144 (as in previous - %% version of MacOS X), but the useful space seem to have - %% shrunk significantly (or possibly the number of arguments). - %% 7673 - 7500; - {_,_} -> - 12000 + {{win32,_},_} -> + %% The maximum size of a command line in the command + %% shell on Windows is 8191 characters. + %% Each -D option is expanded to "@dv NN 1", i.e. + %% 8 characters. (Numbers up to 1295 can be expressed + %% as two 36-base digits.) + 1000; + {{unix,linux},Version} when Version < {2,6,23} -> + %% On some older 64-bit versions of Linux, the maximum number + %% of arguments is 16383. + %% See: http://www.in-ulm.de/~mascheck/various/argmax/ + 5440; + {{unix,darwin},{Major,_,_}} when Major >= 11 -> + %% "getconf ARG_MAX" still reports 262144 (as in previous + %% version of MacOS X), but the useful space seem to have + %% shrunk significantly (or possibly the number of arguments). + %% 7673 + 7500; + {_,_} -> + 12000 end. erlc() -> case os:find_executable("erlc") of - false -> - test_server:fail("Can't find erlc"); - Erlc -> - "\"" ++ Erlc ++ "\"" + false -> + ct:fail("Can't find erlc"); + Erlc -> + "\"" ++ Erlc ++ "\"" end. make_dep_options(Config) -> @@ -264,30 +260,30 @@ make_dep_options(Config) -> DepRE = ["/erl_test_ok[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - "_OK_"], + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + "_OK_"], DepRETarget = - ["^target: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - "_OK_"], + ["^target: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + "_OK_"], DepREMP = - ["/erl_test_ok[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", - [], - "/system_test/erlc_SUITE_data/include/erl_test.hrl:$", - "_OK_"], + ["/erl_test_ok[.]beam: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_ok[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl$", + [], + "/system_test/erlc_SUITE_data/include/erl_test.hrl:$", + "_OK_"], DepREMissing = - ["/erl_test_missing_header[.]beam: \\\\$", - "/system_test/erlc_SUITE_data/src/erl_test_missing_header[.]erl \\\\$", - "/system_test/erlc_SUITE_data/include/erl_test[.]hrl \\\\$", - "missing.hrl$", - "_OK_"], + ["/erl_test_missing_header[.]beam: \\\\$", + "/system_test/erlc_SUITE_data/src/erl_test_missing_header[.]erl \\\\$", + "/system_test/erlc_SUITE_data/include/erl_test[.]hrl \\\\$", + "missing.hrl$", + "_OK_"], %% Test plain -M run(Config, Cmd, FileName, "-M", DepRE), @@ -309,7 +305,7 @@ make_dep_options(Config) -> %% Test -MF File -MT Target TargetDepFile = filename:join(OutDir, "target.deps"), run(Config, Cmd, FileName, "-MF "++TargetDepFile++" -MT target", - ["_OK_"]), + ["_OK_"]), {ok,TargetBin} = file:read_file(TargetDepFile), verify_result(binary_to_list(TargetBin)++["_OK_"], DepRETarget), @@ -358,33 +354,33 @@ split([], Current, Lines) -> match_messages([Msg|Rest1], [Regexp|Rest2]) -> case re:run(Msg, Regexp, [{capture,none}, unicode]) of - match -> - ok; - nomatch -> - io:format("Not matching: ~s\n", [Msg]), - io:format("Regexp : ~s\n", [Regexp]), - test_server:fail(message_mismatch) + match -> + ok; + nomatch -> + io:format("Not matching: ~s\n", [Msg]), + io:format("Regexp : ~s\n", [Regexp]), + ct:fail(message_mismatch) end, match_messages(Rest1, Rest2); match_messages([], [Expect|Rest]) -> - test_server:fail({too_few_messages, [Expect|Rest]}); + ct:fail({too_few_messages, [Expect|Rest]}); match_messages([Msg|Rest], []) -> - test_server:fail({too_many_messages, [Msg|Rest]}); + ct:fail({too_many_messages, [Msg|Rest]}); match_messages([], []) -> ok. get_cmd(Cfg) -> - ?line {SrcDir, IncDir, OutDir} = get_dirs(Cfg), - ?line Cmd = erlc() ++ " -I" ++ IncDir ++ " -o" ++ OutDir ++ " ", + {SrcDir, IncDir, OutDir} = get_dirs(Cfg), + Cmd = erlc() ++ " -I" ++ IncDir ++ " -o" ++ OutDir ++ " ", {SrcDir, OutDir, Cmd}. get_dirs(Cfg) -> - ?line DataDir = ?config(data_dir, Cfg), - ?line PrivDir = ?config(priv_dir, Cfg), - ?line SrcDir = filename:join(DataDir, "src"), - ?line IncDir = filename:join(DataDir, "include"), + DataDir = proplists:get_value(data_dir, Cfg), + PrivDir = proplists:get_value(priv_dir, Cfg), + SrcDir = filename:join(DataDir, "src"), + IncDir = filename:join(DataDir, "include"), {SrcDir, IncDir, PrivDir}. - + exists(Name) -> filelib:is_file(Name). @@ -396,7 +392,7 @@ exists(Name) -> %% a non-zero exit status. run_command(Config, Cmd) -> - TmpDir = filename:join(?config(priv_dir, Config), "tmp"), + TmpDir = filename:join(proplists:get_value(priv_dir, Config), "tmp"), file:make_dir(TmpDir), {RunFile, Run, Script} = run_command(TmpDir, os:type(), Cmd), ok = file:write_file(filename:join(TmpDir, RunFile), unicode:characters_to_binary(Script)), @@ -405,7 +401,7 @@ run_command(Config, Cmd) -> run_command(Dir, {win32, _}, Cmd) -> BatchFile = filename:join(Dir, "run.bat"), Run = re:replace(filename:rootname(BatchFile), "/", "\\", - [global,{return,list}]), + [global,{return,list}]), {BatchFile, Run, ["@echo off\r\n", @@ -426,5 +422,4 @@ run_command(Dir, {unix, _}, Cmd) -> " *) echo '_ERROR_';;\n", "esac\n"]}; run_command(_Dir, Other, _Cmd) -> - M = io_lib:format("Don't know how to test exit code for ~p", [Other]), - test_server:fail(lists:flatten(M)). + ct:fail("Don't know how to test exit code for ~p", [Other]). diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl index 6440cbf0d7..a80d3b43a5 100644 --- a/erts/test/erlexec_SUITE.erl +++ b/erts/test/erlexec_SUITE.erl @@ -27,71 +27,46 @@ %%%------------------------------------------------------------------- -module(erlexec_SUITE). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -%-define(line_trace, 1). - --define(DEFAULT_TIMEOUT, ?t:minutes(1)). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). - --export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1, zdbbl_dist_buf_busy_limit/1]). +-export([args_file/1, evil_args_file/1, env/1, args_file_env/1, + otp_7461/1, otp_7461_remote/1, otp_8209/1, + zdbbl_dist_buf_busy_limit/1]). -include_lib("common_test/include/ct.hrl"). - init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), SavedEnv = save_env(), - [{testcase, Case}, {watchdog, Dog}, {erl_flags_env, SavedEnv} |Config]. + [{testcase, Case},{erl_flags_env, SavedEnv}|Config]. end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - SavedEnv = ?config(erl_flags_env, Config), + SavedEnv = proplists:get_value(erl_flags_env, Config), restore_env(SavedEnv), cleanup_nodes(), - ?t:timetrap_cancel(Dog), ok. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> [args_file, evil_args_file, env, args_file_env, otp_7461, otp_8209, zdbbl_dist_buf_busy_limit]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -otp_8209(doc) -> - ["Test that plain first argument does not " - "destroy -home switch [OTP-8209]"]; -otp_8209(suite) -> - []; +%% Test that plain first argument does not +%% destroy -home switch [OTP-8209] otp_8209(Config) when is_list(Config) -> - ?line {ok,[[PName]]} = init:get_argument(progname), - ?line SNameS = "erlexec_test_01", - ?line SName = list_to_atom(SNameS++"@"++ + {ok,[[PName]]} = init:get_argument(progname), + SNameS = "erlexec_test_01", + SName = list_to_atom(SNameS++"@"++ hd(tl(string:tokens(atom_to_list(node()),"@")))), - ?line Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ + Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()), - ?line open_port({spawn,Cmd},[]), - ?line pong = loop_ping(SName,40), - ?line {ok,[[_]]} = rpc:call(SName,init,get_argument,[home]), - ?line ["dummy_param"] = rpc:call(SName,init,get_plain_arguments,[]), - ?line ok = cleanup_nodes(), + open_port({spawn,Cmd},[]), + pong = loop_ping(SName,40), + {ok,[[_]]} = rpc:call(SName,init,get_argument,[home]), + ["dummy_param"] = rpc:call(SName,init,get_plain_arguments,[]), + ok = cleanup_nodes(), ok. cleanup_nodes() -> @@ -123,17 +98,14 @@ loop_ping(Node,N) -> pong end. -args_file(doc) -> []; -args_file(suite) -> []; args_file(Config) when is_list(Config) -> - ?line AFN1 = privfile("1", Config), - ?line AFN2 = privfile("2", Config), - ?line AFN3 = privfile("3", Config), - ?line AFN4 = privfile("4", Config), - ?line AFN5 = privfile("5", Config), - ?line AFN6 = privfile("6", Config), - ?line write_file(AFN1, - "-MiscArg2~n" + AFN1 = privfile("1", Config), + AFN2 = privfile("2", Config), + AFN3 = privfile("3", Config), + AFN4 = privfile("4", Config), + AFN5 = privfile("5", Config), + AFN6 = privfile("6", Config), + write_file(AFN1, "-MiscArg2~n" "# a comment +\\#1000~n" "+\\#200 # another comment~n" "~n" @@ -145,7 +117,7 @@ args_file(Config) when is_list(Config) -> "+\\#700~n" "-extra +XtraArg6~n", [AFN2]), - ?line write_file(AFN2, + write_file(AFN2, "-MiscArg3~n" "+\\#300~n" "-args_file ~s~n" @@ -156,61 +128,59 @@ args_file(Config) when is_list(Config) -> "-args_file ~s~n" "-extra +XtraArg5~n", [AFN3, AFN4, AFN5, AFN6]), - ?line write_file(AFN3, + write_file(AFN3, "# comment again~n" " -MiscArg4 +\\#400 -extra +XtraArg1"), - ?line write_file(AFN4, + write_file(AFN4, " -MiscArg6 +\\#600 -extra +XtraArg2~n" "+XtraArg3~n" "+XtraArg4~n" "# comment again~n"), - ?line write_file(AFN5, ""), - ?line write_file(AFN6, "-extra # +XtraArg10~n"), - ?line CmdLine = "+#100 -MiscArg1 " + write_file(AFN5, ""), + write_file(AFN6, "-extra # +XtraArg10~n"), + CmdLine = "+#100 -MiscArg1 " ++ "-args_file " ++ AFN1 ++ " +#800 -MiscArg8 -extra +XtraArg7 +XtraArg8", - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400", + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Extra), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8", "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Emu), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800", "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], Misc), - ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", "-#100", "-#200", "-#300", "-#400", "-#500", "-#600", "-#700", "-#800", "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], Extra), - ?line ok. + ok. -evil_args_file(doc) -> []; -evil_args_file(suite) -> []; evil_args_file(Config) when is_list(Config) -> - ?line Lim = 300, - ?line FNums = lists:seq(1, Lim), + Lim = 300, + FNums = lists:seq(1, Lim), lists:foreach(fun (End) when End == Lim -> - ?line AFN = privfile(integer_to_list(End), Config), - ?line write_file(AFN, + AFN = privfile(integer_to_list(End), Config), + write_file(AFN, "-MiscArg~p ", [End]); (I) -> - ?line AFNX = privfile(integer_to_list(I), Config), - ?line AFNY = privfile(integer_to_list(I+1), Config), + AFNX = privfile(integer_to_list(I), Config), + AFNY = privfile(integer_to_list(I+1), Config), {Frmt, Args} = case I rem 2 of 0 -> @@ -220,65 +190,59 @@ evil_args_file(Config) when is_list(Config) -> {"-MiscArg~p -args_file ~s", [I, AFNY]} end, - ?line write_file(AFNX, Frmt, Args) + write_file(AFNX, Frmt, Args) end, FNums), - ?line {_Emu, Misc, _Extra} = emu_args("-args_file " + {_Emu, Misc, _Extra} = emu_args("-args_file " ++ privfile("1", Config)), - ?line ANums = FNums + ANums = FNums ++ lists:reverse(lists:filter(fun (I) when I == Lim -> false; (I) when I rem 2 == 0 -> true; (_) -> false end, FNums)), - ?line verify_args(lists:map(fun (I) -> "-MiscArg"++integer_to_list(I) end, + verify_args(lists:map(fun (I) -> "-MiscArg"++integer_to_list(I) end, ANums), Misc), - ?line ok. + ok. -env(doc) -> []; -env(suite) -> []; env(Config) when is_list(Config) -> - ?line os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -extra +XtraArg1 +XtraArg2"), - ?line CmdLine = "+#200 -MiscArg2 -extra +XtraArg3 +XtraArg4", - ?line os:putenv("ERL_FLAGS", "-MiscArg3 +#300 -extra +XtraArg5"), - ?line os:putenv("ERL_ZFLAGS", "-MiscArg4 +#400 -extra +XtraArg6"), - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4"], + os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -extra +XtraArg1 +XtraArg2"), + CmdLine = "+#200 -MiscArg2 -extra +XtraArg3 +XtraArg4", + os:putenv("ERL_FLAGS", "-MiscArg3 +#300 -extra +XtraArg5"), + os:putenv("ERL_ZFLAGS", "-MiscArg4 +#400 -extra +XtraArg6"), + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400"], Emu), + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6"], Extra), - ?line ok. + ok. -args_file_env(doc) -> []; -args_file_env(suite) -> []; args_file_env(Config) when is_list(Config) -> - ?line AFN1 = privfile("1", Config), - ?line AFN2 = privfile("2", Config), - ?line write_file(AFN1, "-MiscArg2 +\\#200 -extra +XtraArg1"), - ?line write_file(AFN2, "-MiscArg3 +\\#400 -extra +XtraArg3"), - ?line os:putenv("ERL_AFLAGS", + AFN1 = privfile("1", Config), + AFN2 = privfile("2", Config), + write_file(AFN1, "-MiscArg2 +\\#200 -extra +XtraArg1"), + write_file(AFN2, "-MiscArg3 +\\#400 -extra +XtraArg3"), + os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -args_file "++AFN1++ " -extra +XtraArg2"), - ?line CmdLine = "+#300 -args_file "++AFN2++" -MiscArg4 -extra +XtraArg4", - ?line os:putenv("ERL_FLAGS", "-MiscArg5 +#500 -extra +XtraArg5"), - ?line os:putenv("ERL_ZFLAGS", "-MiscArg6 +#600 -extra +XtraArg6"), - ?line {Emu, Misc, Extra} = emu_args(CmdLine), - ?line verify_args(["-#100", "-#200", "-#300", "-#400", + CmdLine = "+#300 -args_file "++AFN2++" -MiscArg4 -extra +XtraArg4", + os:putenv("ERL_FLAGS", "-MiscArg5 +#500 -extra +XtraArg5"), + os:putenv("ERL_ZFLAGS", "-MiscArg6 +#600 -extra +XtraArg6"), + {Emu, Misc, Extra} = emu_args(CmdLine), + verify_args(["-#100", "-#200", "-#300", "-#400", "-#500", "-#600"], Emu), - ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", "-MiscArg5", "-MiscArg6"], Misc), - ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", "+XtraArg5", "+XtraArg6"], Extra), - ?line ok. + ok. %% Make sure "erl -detached" survives when parent process group gets killed -otp_7461(doc) -> []; -otp_7461(suite) -> []; otp_7461(Config) when is_list(Config) -> case os:type() of {unix,_} -> @@ -302,9 +266,9 @@ otp_7461(Config) when is_list(Config) -> otp_7461_do(Config) -> io:format("alive=~p node=~p\n",[is_alive(), node()]), - TestProg = filename:join([?config(data_dir, Config), "erlexec_tests"]), + TestProg = filename:join([proplists:get_value(data_dir, Config), "erlexec_tests"]), {ok, [[ErlProg]]} = init:get_argument(progname), - ?line Cmd = TestProg ++ " " ++ ErlProg ++ + Cmd = TestProg ++ " " ++ ErlProg ++ " -detached -sname " ++ get_nodename(otp_7461) ++ " -setcookie " ++ atom_to_list(erlang:get_cookie()) ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ @@ -314,29 +278,31 @@ otp_7461_do(Config) -> %% open_port fork+exec io:format("spawn port prog ~p\n",[Cmd]), - ?line Port = open_port({spawn, Cmd}, [eof]), + Port = open_port({spawn, Cmd}, [eof]), io:format("Wait for node to connect...\n",[]), - ?line {nodeup, Slave} = receive Msg -> Msg + {nodeup, Slave} = receive Msg -> Msg after 20*1000 -> timeout end, io:format("Node alive: ~p\n", [Slave]), - ?line pong = net_adm:ping(Slave), + pong = net_adm:ping(Slave), io:format("Ping ok towards ~p\n", [Slave]), - ?line Port ! { self(), {command, "K"}}, % Kill child process group - ?line {Port, {data, "K"}} = receive Msg2 -> Msg2 end, - ?line port_close(Port), + Port ! { self(), {command, "K"}}, % Kill child process group + {Port, {data, "K"}} = receive Msg2 -> Msg2 end, + port_close(Port), %% Now the actual test. Detached node should still be alive. - ?line pong = net_adm:ping(Slave), + pong = net_adm:ping(Slave), io:format("Ping still ok towards ~p\n", [Slave]), %% Halt node - ?line rpc:cast(Slave, ?MODULE, otp_7461_remote, [[halt, self()]]), + rpc:cast(Slave, ?MODULE, otp_7461_remote, [[halt, self()]]), - ?line {nodedown, Slave} = receive Msg3 -> Msg3 - after 20*1000 -> timeout end, + {nodedown, Slave} = receive + Msg3 -> Msg3 + after 20*1000 -> timeout + end, io:format("Node dead: ~p\n", [Slave]), ok. @@ -349,24 +315,21 @@ otp_7461_remote([halt, Pid]) -> io:format("halt order from ~p to node ~p\n",[Pid,node()]), halt(). -zdbbl_dist_buf_busy_limit(doc) -> - ["Check +zdbbl flag"]; -zdbbl_dist_buf_busy_limit(suite) -> - []; +%% Check +zdbbl flag zdbbl_dist_buf_busy_limit(Config) when is_list(Config) -> LimKB = 1122233, LimB = LimKB*1024, - ?line {ok,[[PName]]} = init:get_argument(progname), - ?line SNameS = "erlexec_test_02", - ?line SName = list_to_atom(SNameS++"@"++ + {ok,[[PName]]} = init:get_argument(progname), + SNameS = "erlexec_test_02", + SName = list_to_atom(SNameS++"@"++ hd(tl(string:tokens(atom_to_list(node()),"@")))), - ?line Cmd = PName ++ " -sname "++SNameS++" -setcookie "++ + Cmd = PName ++ " -sname "++SNameS++" -setcookie "++ atom_to_list(erlang:get_cookie()) ++ " +zdbbl " ++ integer_to_list(LimKB), - ?line open_port({spawn,Cmd},[]), - ?line pong = loop_ping(SName,40), - ?line LimB = rpc:call(SName,erlang,system_info,[dist_buf_busy_limit]), - ?line ok = cleanup_node(SNameS, 10), + open_port({spawn,Cmd},[]), + pong = loop_ping(SName,40), + LimB = rpc:call(SName,erlang,system_info,[dist_buf_busy_limit]), + ok = cleanup_node(SNameS, 10), ok. @@ -404,8 +367,8 @@ restore_env({erl_flags, AFlgs, Flgs, RFlgs, ZFlgs}) -> ok. privfile(Name, Config) -> - filename:join([?config(priv_dir, Config), - atom_to_list(?config(testcase, Config)) ++ "." ++ Name]). + filename:join([proplists:get_value(priv_dir, Config), + atom_to_list(proplists:get_value(testcase, Config)) ++ "." ++ Name]). write_file(FileName, Frmt) -> write_file(FileName, Frmt, []). @@ -430,8 +393,7 @@ verify_not_args(Xs, Ys) -> true -> exit({arg_present, X}); false -> ok end - end, - Xs). + end, Xs). emu_args(CmdLineArgs) -> io:format("CmdLineArgs = ~ts~n", [CmdLineArgs]), diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl index 8ad2a32278..7bea9e0ecf 100644 --- a/erts/test/ethread_SUITE.erl +++ b/erts/test/ethread_SUITE.erl @@ -28,13 +28,7 @@ -module(ethread_SUITE). -author('[email protected]'). -%-define(line_trace, 1). - --define(DEFAULT_TIMEOUT, ?t:minutes(10)). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, init_per_testcase/2, end_per_testcase/2]). -export([create_join_thread/1, equal_tids/1, @@ -53,7 +47,11 @@ -include_lib("common_test/include/ct.hrl"). -tests() -> +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. + +all() -> [create_join_thread, equal_tids, mutex, @@ -69,78 +67,50 @@ tests() -> atomic, dw_atomic_massage]. -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - tests(). - -groups() -> - []. - -init_per_suite(Config) -> - Config. +init_per_testcase(Case, Config) -> + case inet:gethostname() of + {ok,"fenris"} when Case == max_threads -> + %% Cannot use os:type+os:version as not all + %% solaris10 machines are buggy. + {skip, "This machine is buggy"}; + _Else -> + Config + end. -end_per_suite(_Config) -> +end_per_testcase(_Case, _Config) -> ok. -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% %% %% The test-cases %% %% -create_join_thread(doc) -> - ["Tests ethr_thr_create and ethr_thr_join."]; -create_join_thread(suite) -> - []; +%% Tests ethr_thr_create and ethr_thr_join. create_join_thread(Config) -> run_case(Config, "create_join_thread", ""). -equal_tids(doc) -> - ["Tests ethr_equal_tids."]; -equal_tids(suite) -> - []; +%% Tests ethr_equal_tids. equal_tids(Config) -> run_case(Config, "equal_tids", ""). -mutex(doc) -> - ["Tests mutexes."]; -mutex(suite) -> - []; +%% Tests mutexes. mutex(Config) -> run_case(Config, "mutex", ""). -try_lock_mutex(doc) -> - ["Tests try lock on mutex."]; -try_lock_mutex(suite) -> - []; +%% Tests try lock on mutex. try_lock_mutex(Config) -> run_case(Config, "try_lock_mutex", ""). -cond_wait(doc) -> - ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."]; -cond_wait(suite) -> - []; +%% Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast. cond_wait(Config) -> run_case(Config, "cond_wait", ""). -broadcast(doc) -> - ["Tests that a ethr_cond_broadcast really wakes up all waiting threads"]; -broadcast(suite) -> - []; +%% Tests that a ethr_cond_broadcast really wakes up all waiting threads broadcast(Config) -> run_case(Config, "broadcast", ""). -detached_thread(doc) -> - ["Tests detached threads."]; -detached_thread(suite) -> - []; +%% Tests detached threads. detached_thread(Config) -> case {os:type(), os:version()} of {{unix,darwin}, {9, _, _}} -> @@ -152,10 +122,7 @@ detached_thread(Config) -> run_case(Config, "detached_thread", "") end. -max_threads(doc) -> - ["Tests maximum number of threads."]; -max_threads(suite) -> - []; +%% Tests maximum number of threads. max_threads(Config) -> case {os:type(), os:version()} of {{unix,darwin}, {9, _, _}} -> @@ -167,45 +134,27 @@ max_threads(Config) -> run_case(Config, "max_threads", "") end. -tsd(doc) -> - ["Tests thread specific data."]; -tsd(suite) -> - []; +%% Tests thread specific data. tsd(Config) -> run_case(Config, "tsd", ""). -spinlock(doc) -> - ["Tests spinlocks."]; -spinlock(suite) -> - []; +%% Tests spinlocks. spinlock(Config) -> run_case(Config, "spinlock", ""). -rwspinlock(doc) -> - ["Tests rwspinlocks."]; -rwspinlock(suite) -> - []; +%% Tests rwspinlocks. rwspinlock(Config) -> run_case(Config, "rwspinlock", ""). -rwmutex(doc) -> - ["Tests rwmutexes."]; -rwmutex(suite) -> - []; +%% Tests rwmutexes. rwmutex(Config) -> run_case(Config, "rwmutex", ""). -atomic(doc) -> - ["Tests atomics."]; -atomic(suite) -> - []; +%% Tests atomics. atomic(Config) -> run_case(Config, "atomic", ""). -dw_atomic_massage(doc) -> - ["Massage double word atomics"]; -dw_atomic_massage(suite) -> - []; +%% Massage double word atomics dw_atomic_massage(Config) -> run_case(Config, "dw_atomic_massage", ""). @@ -215,22 +164,6 @@ dw_atomic_massage(Config) -> %% %% -init_per_testcase(Case, Config) -> - case inet:gethostname() of - {ok,"fenris"} when Case == max_threads -> - %% Cannot use os:type+os:version as not all - %% solaris10 machines are buggy. - {skip, "This machine is buggy"}; - _Else -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}|Config] - end. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -define(TESTPROG, "ethread_tests"). -define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). -define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P). @@ -238,68 +171,68 @@ end_per_testcase(_Case, Config) -> -define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D). port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> - ?line process_flag(trap_exit, true), - ?line Ref = erlang:monitor(process, EProc), - ?line receive - {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), - element(1, Reason) - == timetrap_timeout -> - ?line Cmd = "kill -9 " ++ OSProc, - ?line ?t:format("Test case timed out. " - "Trying to kill port program.~n" - " Executing: ~p~n", [Cmd]), - ?line case os:cmd(Cmd) of - [] -> - ok; - OsCmdRes -> - ?line ?t:format(" ~s", [OsCmdRes]) - end; - {'DOWN', Ref, _, _, _} -> - %% OSProc is assumed to have terminated by itself - ?line ok - end. + process_flag(trap_exit, true), + Ref = erlang:monitor(process, EProc), + receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + Cmd = "kill -9 " ++ OSProc, + io:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + io:format(" ~s", [OsCmdRes]) + end; + %% OSProc is assumed to have terminated by itself + {'DOWN', Ref, _, _, _} -> + ok + end. get_line(_Port, eol, Data) -> - ?line Data; + Data; get_line(Port, noeol, Data) -> - ?line receive + receive {Port, {data, {Flag, NextData}}} -> - ?line get_line(Port, Flag, Data ++ NextData); + get_line(Port, Flag, Data ++ NextData); {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) + ct:fail(port_prog_unexpectedly_closed) end. read_case_data(Port, TestCase) -> - ?line receive - {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> - ?line ok; - {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> - ?line {comment, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> - ?line {skipped, get_line(Port, Flag, CommentStart)}; - {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> - ?line ?t:fail(get_line(Port, Flag, ReasonStart)); - {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> - ?line ?t:format("Port program pid: ~s~n", [PidStr]), - ?line CaseProc = self(), - ?line _ = list_to_integer(PidStr), % Sanity check - spawn_opt(fun () -> - port_prog_killer(CaseProc, PidStr) - end, - [{priority, max}, link]), - read_case_data(Port, TestCase); - {Port, {data, {Flag, LineStart}}} -> - ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), - read_case_data(Port, TestCase); - {Port, eof} -> - ?line ?t:fail(port_prog_unexpectedly_closed) - end. + receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ct:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + io:format("Port program pid: ~s~n", [PidStr]), + CaseProc = self(), + _ = list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + io:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ct:fail(port_prog_unexpectedly_closed) + end. run_case(Config, Test, TestArgs) -> run_case(Config, Test, TestArgs, fun (_Port) -> ok end). run_case(Config, Test, TestArgs, Fun) -> - TestProg = filename:join([?config(data_dir, Config), ?TESTPROG]), + TestProg = filename:join([proplists:get_value(data_dir, Config), ?TESTPROG]), Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, case catch open_port({spawn, Cmd}, [stream, use_stdio, @@ -307,17 +240,13 @@ run_case(Config, Test, TestArgs, Fun) -> eof, {line, 1024}]) of Port when is_port(Port) -> - ?line Fun(Port), - ?line CaseResult = read_case_data(Port, Test), - ?line receive - {Port, eof} -> - ?line ok - end, - ?line CaseResult; + Fun(Port), + CaseResult = read_case_data(Port, Test), + receive + {Port, eof} -> + ok + end, + CaseResult; Error -> - ?line ?t:fail({open_port_failed, Error}) + ct:fail({open_port_failed, Error}) end. - - - - diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl index e40b91392c..da6f6850c6 100644 --- a/erts/test/ignore_cores.erl +++ b/erts/test/ignore_cores.erl @@ -53,7 +53,7 @@ init(Config) -> fini(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), ok = file:set_cwd(OrgCWD), true = code:set_path(OrgPath), case OrgPWD of @@ -70,10 +70,10 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), is_list(Config) -> #ignore_cores{org_cwd = OrgCWD, org_path = OrgPath, - org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + org_pwd_env = OrgPWD} = proplists:get_value(ignore_cores, Config), Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), true = code:set_path(Path), - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), IgnDir = filename:join([PrivDir, atom_to_list(Suite) ++ "_" @@ -94,7 +94,7 @@ setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), end, ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), %% cores are dumped in /cores on MacOS X - CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + CoresDir = case {os:type(), filelib:is_dir("/cores")} of {{unix,darwin}, true} -> filelib:fold_files("/cores", "^core.*$", @@ -119,7 +119,7 @@ restore(Config) -> org_path = OrgPath, org_pwd_env = OrgPWD, ign_dir = IgnDir, - cores_dir = CoresDir} = ?config(ignore_cores, Config), + cores_dir = CoresDir} = proplists:get_value(ignore_cores, Config), try case CoresDir of false -> @@ -155,5 +155,5 @@ restore(Config) -> dir(Config) -> - #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + #ignore_cores{ign_dir = Dir} = proplists:get_value(ignore_cores, Config), Dir. diff --git a/erts/test/install_SUITE.erl b/erts/test/install_SUITE.erl index d6df1aab6b..a9a90dcf1e 100644 --- a/erts/test/install_SUITE.erl +++ b/erts/test/install_SUITE.erl @@ -28,11 +28,9 @@ %%%------------------------------------------------------------------- -module(install_SUITE). -%-define(line_trace, 1). - --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1, end_per_suite/1, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, + init_per_suite/1, end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([bin_default/1, bin_default_dirty/1, @@ -49,7 +47,6 @@ bin_dirname_fail/1, bin_no_use_dirname_fail/1]). --define(DEFAULT_TIMEOUT, ?t:minutes(1)). -define(JOIN(A,B,C), filename:join(A, B, C)). -include_lib("common_test/include/ct.hrl"). @@ -77,49 +74,42 @@ dont_need_symlink_cases() -> bin_unreasonable_path, 'bin white space', bin_no_srcfile]. -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 1}}]. all() -> dont_need_symlink_cases() ++ need_symlink_cases(). -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - %% %% The test cases %% bin_default(Config) when is_list(Config) -> - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -128,30 +118,30 @@ bin_default(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_default_dirty(Config) when is_list(Config) -> - ?line E = "/usr/./local/lib/..", - ?line Bs = "/usr/local//lib/../lib/erlang/../../bin", - ?line Be = "/usr/local/lib/../lib/erlang/../../bin", - ?line EBs = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..//", - ?line EBe = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..", - ?line RP = "../lib/erlang/bin", + E = "/usr/./local/lib/..", + Bs = "/usr/local//lib/../lib/erlang/../../bin", + Be = "/usr/local/lib/../lib/erlang/../../bin", + EBs = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..//", + EBe = "/usr/local/lib/../lib/erlang/../erlang/bin/x/y/../..", + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -161,29 +151,29 @@ bin_default_dirty(Config) when is_list(Config) -> bin_outside_eprfx(Config) when is_list(Config) -> - ?line E = "/usr/local", - ?line Bs = "/usr/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../local/lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {ok,{relative,B,RP}}; + {ok,{relative,B,RP}}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -193,29 +183,29 @@ bin_outside_eprfx(Config) when is_list(Config) -> bin_outside_eprfx_dirty(Config) when is_list(Config) -> - ?line E = "/usr/local/lib/..", - ?line Bs = "/usr/local/lib/../../bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../local/lib/erlang/bin", + E = "/usr/local/lib/..", + Bs = "/usr/local/lib/../../bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {ok,{relative,B,RP}}; + {ok,{relative,B,RP}}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -224,33 +214,33 @@ bin_outside_eprfx_dirty(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreasonable_path(Config) when is_list(Config) -> - ?line E = "/usr/local/../../..", - ?line Bs = "/usr/local/../../../bin", - ?line Be = Bs, - ?line EBs = "/usr/local/../../../bin_unreasonable_path/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../bin_unreasonable_path/usr/local/lib/erlang/bin", + E = "/usr/local/../../..", + Bs = "/usr/local/../../../bin", + Be = Bs, + EBs = "/usr/local/../../../bin_unreasonable_path/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../bin_unreasonable_path/usr/local/lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {TP, SL, BSL} of {_, false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {_, false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {"", true, "relative"} -> {error, unreasonable_path}; {"", true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {_, true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; _ -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -259,7 +249,7 @@ bin_unreasonable_path(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreachable_absolute(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/lib/erlang/usr/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -270,28 +260,28 @@ bin_unreachable_absolute(Config) when is_list(Config) -> ok = file:write_file(Erlc, "erlc"), ok = file:make_symlink("../../../opt/local/lib/erlang/usr", join([TDir, "/usr/local/lib/erlang"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/../bin", - ?line EBe = EBs, + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/../bin", + EBe = EBs, ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> {error, unreachable_absolute}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -300,7 +290,7 @@ bin_unreachable_absolute(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_unreachable_relative(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/lib/erlang/bin"), make_dirs(TDir, "/opt/local/bin"), make_dirs(TDir, "/usr/local/lib/erlang/bin"), @@ -311,28 +301,28 @@ bin_unreachable_relative(Config) when is_list(Config) -> ok = file:make_symlink("../../opt/local/bin", join([TDir, "/usr/local/bin"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> {error, unreachable_relative}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -341,7 +331,7 @@ bin_unreachable_relative(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_ok_symlink(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/usr/local/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -350,29 +340,29 @@ bin_ok_symlink(Config) when is_list(Config) -> ok = file:write_file(Erlc, "erlc"), ok = file:make_symlink("../../opt/local/lib", join([TDir, "/usr/local/lib"])), - ?line E = "/usr/local", - ?line Bs = "/usr/local/bin", - ?line Be = Bs, - ?line EBs = "/usr/local/lib/erlang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/bin", + E = "/usr/local", + Bs = "/usr/local/bin", + Be = Bs, + EBs = "/usr/local/lib/erlang/bin", + EBe = EBs, + RP = "../lib/erlang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -381,7 +371,7 @@ bin_ok_symlink(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_same_dir(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/usr/local/bin"), make_dirs(TDir, "/usr/local/lib"), ok = file:make_symlink("..", join([TDir, "/usr/local/lib/erlang"])), @@ -417,29 +407,29 @@ bin_not_abs(Config) when is_list(Config) -> 'bin white space'(Config) when is_list(Config) -> - ?line E = "/u s r/local", - ?line Bs = "/u s r/local/b i n", - ?line Be = Bs, - ?line EBs = "/u s r/local/lib/erl ang/bin", - ?line EBe = EBs, - ?line RP = "../lib/erl ang/bin", + E = "/u s r/local", + Bs = "/u s r/local/b i n", + Be = Bs, + EBs = "/u s r/local/lib/erl ang/bin", + EBe = EBs, + RP = "../lib/erl ang/bin", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -448,29 +438,29 @@ bin_not_abs(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_dirname_fail(Config) when is_list(Config) -> - ?line E = "/opt", - ?line Bs = "/opt/lib/../bin", - ?line Be = Bs, - ?line EBs = "/opt/lib/erlang/otp/bin", - ?line EBe = EBs, - ?line CMDPRFX = "PATH=\""++?config(data_dir,Config)++":"++os:getenv("PATH")++"\"", + E = "/opt", + Bs = "/opt/lib/../bin", + Be = Bs, + EBs = "/opt/lib/erlang/otp/bin", + EBe = EBs, + CMDPRFX = "PATH=\""++proplists:get_value(data_dir,Config)++":"++os:getenv("PATH")++"\"", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "relative"} -> - ?line {error, dirname_failed}; + {error, dirname_failed}; {true, _} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}} + {ok,{absolute,B,join([TP,EP,EBe])}} end, expect(Expct, Res) end, @@ -480,30 +470,30 @@ bin_dirname_fail(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_no_use_dirname_fail(Config) when is_list(Config) -> - ?line E = "/opt", - ?line Bs = "/opt/bin", - ?line Be = Bs, - ?line EBs = "/opt/lib/erlang/otp/bin", - ?line EBe = EBs, - ?line RP = "../lib/erlang/otp/bin", - ?line CMDPRFX = "PATH=\""++?config(data_dir,Config)++":"++os:getenv("PATH")++"\"", + E = "/opt", + Bs = "/opt/bin", + Be = Bs, + EBs = "/opt/lib/erlang/otp/bin", + EBe = EBs, + RP = "../lib/erlang/otp/bin", + CMDPRFX = "PATH=\""++proplists:get_value(data_dir,Config)++":"++os:getenv("PATH")++"\"", ChkRes = fun (Res, #inst{test_prefix = TP, destdir = D, extra_prefix = EP, bindir_symlinks = BSL, symlinks = SL}) -> - ?line B = join([TP, D, EP, Be]), + B = join([TP, D, EP, Be]), Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false, _} -> - ?line {ok,{absolute, + {ok,{absolute, B,join([TP,D,EP,EBe])}}; {true, "absolute"} -> - ?line {ok,{absolute,B,join([TP,EP,EBe])}}; + {ok,{absolute,B,join([TP,EP,EBe])}}; {true, _} -> - ?line {ok,{relative,B,RP}} + {ok,{relative,B,RP}} end, expect(Expct, Res) end, @@ -513,7 +503,7 @@ bin_no_use_dirname_fail(Config) when is_list(Config) -> erlang_bindir = EBs}, ChkRes). bin_no_srcfile(Config) when is_list(Config) -> - TDir = ?config(test_dir, Config), + TDir = proplists:get_value(test_dir, Config), make_dirs(TDir, "/opt/local/bin"), make_dirs(TDir, "/opt/local/lib/erlang/bin"), Erl = join([TDir, "/opt/local/lib/erlang/bin/erl"]), @@ -525,13 +515,13 @@ bin_no_srcfile(Config) when is_list(Config) -> Expct = case {SL, BSL} of {false, _} when BSL == "relative"; BSL == "absolute" -> - ?line {error, no_ln_s}; + {error, no_ln_s}; {false,_} -> - ?line {error,{no_srcfile, Erlc}}; + {error,{no_srcfile, Erlc}}; {true, "absolute"} -> - ?line {error,{no_srcfile, Erlc}}; + {error,{no_srcfile, Erlc}}; {true, _} -> - ?line {error,{no_srcfile, RP_Erlc}} + {error,{no_srcfile, RP_Erlc}} end, expect(Expct, Res) end, @@ -549,34 +539,34 @@ bin_no_srcfile(Config) when is_list(Config) -> %% expect(X, X) -> - ?t:format("result: ~p~n", [X]), - ?t:format("-----------------------------------------------~n", []), + io:format("result: ~p~n", [X]), + io:format("-----------------------------------------------~n", []), ok; expect(X, Y) -> - ?t:format("expected: ~p~n", [X]), - ?t:format("got : ~p~n", [Y]), - ?t:format("-----------------------------------------------~n", []), - ?t:fail({X,Y}). + io:format("expected: ~p~n", [X]), + io:format("got : ~p~n", [Y]), + io:format("-----------------------------------------------~n", []), + ct:fail({X,Y}). init_per_suite(Config) -> - PD = ?config(priv_dir, Config), - SymLinks = case ?t:os_type() of - {win32, _} -> false; - _ -> - case file:make_symlink("nothing", - filename:join(PD, - "symlink_test")) of - ok -> true; - _ -> false - end - end, + PD = proplists:get_value(priv_dir, Config), + SymLinks = case os:type() of + {win32, _} -> false; + _ -> + case file:make_symlink("nothing", + filename:join(PD, "symlink_test")) of + ok -> true; + _ -> false + end + end, [{symlinks, SymLinks} | Config]. end_per_suite(_Config) -> ok. init_per_testcase(Case, Config) -> - init_per_testcase_aux(?config(symlinks,Config),?t:os_type(),Case,Config). + init_per_testcase_aux(proplists:get_value(symlinks,Config), + os:type(),Case,Config). init_per_testcase_aux(_, {win32, _}, _Case, _Config) -> {skip, "Not on windows"}; @@ -586,18 +576,13 @@ init_per_testcase_aux(false, OsType, Case, Config) -> true -> {skip, "Cannot create symbolic links"} end; init_per_testcase_aux(true, _OsType, Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{watchdog, Dog}, - {testcase, Case}, - {test_dir, make_dirs(?config(priv_dir, Config), atom_to_list(Case))} + [{testcase, Case}, + {test_dir, make_dirs(proplists:get_value(priv_dir, Config), atom_to_list(Case))} | Config]. -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), +end_per_testcase(_Case, _Config) -> ok. - make_dirs(Root, Suffix) -> do_make_dirs(Root, string:tokens(Suffix, [$/])). @@ -616,9 +601,9 @@ install_bin(Config, #inst{mkdirs = MkDirs, exec_prefix = EXEC_PREFIX, bindir = BINDIR, erlang_bindir = ERLANG_BINDIR} = Inst, ChkRes) -> - PDir = ?config(priv_dir, Config), - TDir = ?config(test_dir, Config), - TD = atom_to_list(?config(testcase, Config)), + PDir = proplists:get_value(priv_dir, Config), + TDir = proplists:get_value(test_dir, Config), + TD = atom_to_list(proplists:get_value(testcase, Config)), case MkDirs of false -> ok; true -> @@ -641,7 +626,7 @@ install_bin(Config, #inst{mkdirs = MkDirs, bindir = join([TDir, BINDIR]), erlang_bindir = join([TDir, ERLANG_BINDIR])}, ChkRes), - case ?config(symlinks, Config) of + case proplists:get_value(symlinks, Config) of true -> ok; false -> {comment, "No symlink tests run, since symlinks not working"} end. @@ -664,7 +649,7 @@ install_bin2(Config, Inst, ChkRes) -> install_bin3(Config, Inst#inst{symlinks = false, ln_s = "cp -p", bindir_symlinks = "absolute"}, ChkRes), - case ?config(symlinks, Config) of + case proplists:get_value(symlinks, Config) of true -> install_bin3(Config, Inst#inst{symlinks = true, ln_s = "ln -s"}, ChkRes), @@ -690,9 +675,9 @@ install_bin3(Config, erlang_bindir = ERLANG_BINDIR, bindir_symlinks = BINDIR_SYMLINKS} = Inst, ChkRes) -> - Test = ?config(testcase, Config), - DDir = ?config(data_dir, Config), - TDir = ?config(test_dir, Config), + Test = proplists:get_value(testcase, Config), + DDir = proplists:get_value(data_dir, Config), + TDir = proplists:get_value(test_dir, Config), InstallBin = filename:join(DDir, "install_bin"), ResFile = filename:join(TDir, atom_to_list(Test) ++ "-result.txt"), Cmd = CMD_PRFX ++ " " @@ -705,7 +690,7 @@ install_bin3(Config, ++ "\" --exec-prefix \"" ++ EXEC_PREFIX ++ "\" --test-file \"" ++ ResFile ++ "\" erl erlc", - ?t:format("CMD_PRFX = \"~s\"~n" + io:format("CMD_PRFX = \"~s\"~n" "LN_S = \"~s\"~n" "BINDIR_SYMLINKS = \"~s\"~n" "exec_prefix = \"~s\"~n" @@ -716,9 +701,9 @@ install_bin3(Config, [CMD_PRFX, LN_S, BINDIR_SYMLINKS, EXEC_PREFIX, BINDIR, ERLANG_BINDIR, EXTRA_PREFIX, DESTDIR]), - ?t:format("$ ~s~n", [Cmd]), + io:format("$ ~s~n", [Cmd]), CmdOutput = os:cmd(Cmd), - ?t:format("~s~n", [CmdOutput]), + io:format("~s~n", [CmdOutput]), ChkRes(case file:consult(ResFile) of {ok, [Res]} -> Res; Err -> exit({result, Err}) @@ -731,4 +716,3 @@ join([""|Ds]) -> join(Ds); join([D|Ds]) -> "/" ++ string:strip(D, both, $/) ++ join(Ds). - diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl index 1ddaaaaeb5..be24018b5d 100644 --- a/erts/test/nt_SUITE.erl +++ b/erts/test/nt_SUITE.erl @@ -23,55 +23,36 @@ -include_lib("common_test/include/ct.hrl"). -include_lib("kernel/include/file.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2,init_per_testcase/2, - end_per_testcase/2,nt/1,handle_eventlog/2, - middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, - service_prio/1, - logout/1, debug/1, restart/1, restart_always/1,stopaction/1, - shutdown_io/0,do_shutdown_io/0]). --define(TEST_TIMEOUT, ?t:seconds(180)). +-export([all/0, suite/0, + init_per_testcase/2, end_per_testcase/2, + nt/1,handle_eventlog/2, + middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, + service_prio/1, + logout/1, debug/1, restart/1, restart_always/1,stopaction/1, + shutdown_io/0,do_shutdown_io/0]). -define(TEST_SERVICES, [1,2,3,4,5,6,7,8,9,10,11]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> case os:type() of - {win32, nt} -> - [nt, service_basic, service_env, user_env, synced, - service_prio, logout, debug, restart, restart_always, - stopaction]; - _ -> [nt] + {win32, nt} -> + [nt, service_basic, service_env, user_env, synced, + service_prio, logout, debug, restart, restart_always, + stopaction]; + _ -> [nt] end. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_testcase(_Func, Config) -> - Dog = test_server:timetrap(?TEST_TIMEOUT), - [{watchdog, Dog} | Config]. + Config. -end_per_testcase(_Func, Config) -> +end_per_testcase(_Func, _Config) -> lists:foreach(fun(X) -> - catch remove_service("test_service_" ++ - integer_to_list(X)) end, - ?TEST_SERVICES), - Dog = ?config(watchdog, Config), - catch test_server:timetrap_cancel(Dog), + catch remove_service("test_service_" ++ integer_to_list(X)) + end, ?TEST_SERVICES), ok. erlsrv() -> @@ -80,19 +61,18 @@ erlsrv() -> recv_prog_output(Port) -> receive - {Port, {data, {eol,Data}}} -> - %%io:format("Got data: ~s~n", [Data]), - [ Data | recv_prog_output(Port)]; - _X -> - %%io:format("Got data: ~p~n", [_X]), - Port ! {self(), close}, - receive - _ -> - [] - end + {Port, {data, {eol,Data}}} -> + %%io:format("Got data: ~s~n", [Data]), + [ Data | recv_prog_output(Port)]; + _X -> + %%io:format("Got data: ~p~n", [_X]), + Port ! {self(), close}, + receive + _ -> + [] + end end. - %%% X == parameters to erlsrv %%% returns command output without stderr do_command(X) -> @@ -100,11 +80,11 @@ do_command(X) -> Port = open_port({spawn, erlsrv() ++ " " ++ X}, [stream, {line, 100}, eof, in]), Res = recv_prog_output(Port), case Res of - [] -> - failed; - _Y -> - %%io:format("~p~n",[_Y]), - ok + [] -> + failed; + _Y -> + %%io:format("~p~n",[_Y]), + ok end. @@ -123,13 +103,13 @@ do_wait_for_it(_,0) -> false; do_wait_for_it(FullName,N) -> case net_adm:ping(FullName) of - pong -> - true; - _ -> - receive - after 1000 -> - do_wait_for_it(FullName,N-1) - end + pong -> + true; + _ -> + receive + after 1000 -> + do_wait_for_it(FullName,N-1) + end end. wait_for_node(Name) -> @@ -139,309 +119,280 @@ wait_for_node(Name) -> make_full_name(Name) -> [_,Suffix] = string:tokens(atom_to_list(node()),"@"), list_to_atom(Name ++ "@" ++ Suffix). - + %%% The following tests are only run on NT: -service_basic(doc) -> - ["Check some basic (cosmetic) service parameters"]; -service_basic(suite) -> []; +%% Check some basic (cosmetic) service parameters service_basic(Config) when is_list(Config) -> - ?line Name = "test_service_20", - ?line IntName = Name++"_internal", - ?line Service = [{servicename,Name}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}, - {internalservicename,IntName}, - {comment,"Epic comment"}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line S2 = erlsrv:get_service(Name), - ?line {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2), - ?line {value,{internalservicename,IntName}} = - lists:keysearch(internalservicename,1,S2), - ?line S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}), - ?line S4 = lists:keyreplace(internalservicename,1,S3, - {internalservicename,"WillNotHappen"}), - ?line ok = erlsrv:store_service(S4), - ?line S5 = erlsrv:get_service(Name), - ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5), - ?line {value,{internalservicename,IntName}} = - lists:keysearch(internalservicename,1,S5), - ?line NewName = "test_service_21", - ?line S6 = erlsrv:new_service(NewName,S5,[]), % should remove - % internalservicename - ?line ok = erlsrv:store_service(S6), - ?line S7 = erlsrv:get_service(NewName), - ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7), - ?line {value,{internalservicename,[$t,$e,$s,$t | _]}} = - lists:keysearch(internalservicename,1,S7), - ?line remove_service(Name), - ?line remove_service(NewName), + Name = "test_service_20", + IntName = Name++"_internal", + Service = [{servicename,Name}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}, + {internalservicename,IntName}, + {comment,"Epic comment"}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + S2 = erlsrv:get_service(Name), + {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2), + {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S2), + S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}), + S4 = lists:keyreplace(internalservicename,1,S3, + {internalservicename,"WillNotHappen"}), + ok = erlsrv:store_service(S4), + S5 = erlsrv:get_service(Name), + {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5), + {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S5), + NewName = "test_service_21", + S6 = erlsrv:new_service(NewName,S5,[]), % should remove + % internalservicename + ok = erlsrv:store_service(S6), + S7 = erlsrv:get_service(NewName), + {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7), + {value,{internalservicename,[$t,$e,$s,$t | _]}} = + lists:keysearch(internalservicename,1,S7), + remove_service(Name), + remove_service(NewName), ok. -service_env(doc) -> - ["Check that service name and executable is in the environment of the " ++ - "erlang process created by erlsrv."]; -service_env(suite) -> []; +%% Check that service name and executable is in the environment of the +%% erlang process created by erlsrv. service_env(Config) when is_list(Config) -> - ?line Name = "test_service_2", - ?line Service = [{servicename,Name}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line Name = rpc:call(make_full_name(Name),os,getenv, - ["ERLSRV_SERVICE_NAME"]), - ?line "erlsrv.exe" = filename:basename( - hd( - string:tokens( - rpc:call(make_full_name(Name), - os, - getenv, - ["ERLSRV_EXECUTABLE"]), - "\""))), - ?line remove_service(Name), + Name = "test_service_2", + Service = [{servicename,Name}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + Name = rpc:call(make_full_name(Name),os,getenv, + ["ERLSRV_SERVICE_NAME"]), + "erlsrv.exe" = filename:basename( + hd( + string:tokens( + rpc:call(make_full_name(Name), + os, + getenv, + ["ERLSRV_EXECUTABLE"]), + "\""))), + remove_service(Name), ok. -user_env(doc) -> - ["Check that the user defined environment is ADDED to the service's"++ - " normal dito."]; -user_env(suite) -> []; + +%% Check that the user defined environment is ADDED to the service's +%% normal dito. user_env(Config) when is_list(Config) -> - ?line Name = "test_service_3", - ?line Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line true = rpc:call(make_full_name(Name),os,getenv, - ["SystemDrive"]) =/= false, - ?line "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]), - ?line remove_service(Name), + Name = "test_service_3", + Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + true = rpc:call(make_full_name(Name),os,getenv, + ["SystemDrive"]) =/= false, + "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]), + remove_service(Name), ok. -synced(doc) -> - ["Check that services are stopped and started syncronous and that"++ - " failed stopactions kill the erlang machine anyway."]; -synced(suite) -> []; + +%% Check that services are stopped and started syncronous and that +%% failed stopactions kill the erlang machine anyway. synced(Config) when is_list(Config) -> - ?line Name0 = "test_service_4", - ?line Service0 = [{servicename,Name0}, - {machine, "N:\\nickeNyfikenPaSjukhus"}], - ?line ok = erlsrv:store_service(Service0), - ?line true = (catch start_service(Name0)) =/= ok, - ?line remove_service(Name0), - ?line Name = "test_service_5", - ?line Service = [{servicename,Name}, - {stopaction,"erlang:info(garbage_collection)."}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line stop_service(Name), - ?line Diff1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T1, - ?line true = Diff1 > 30, - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T2 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line remove_service(Name), - ?line Diff2 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T2, - ?line true = Diff2 > 30, + Name0 = "test_service_4", + Service0 = [{servicename,Name0}, + {machine, "N:\\nickeNyfikenPaSjukhus"}], + ok = erlsrv:store_service(Service0), + true = (catch start_service(Name0)) =/= ok, + remove_service(Name0), + Name = "test_service_5", + Service = [{servicename,Name}, + {stopaction,"erlang:info(garbage_collection)."}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + stop_service(Name), + Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + true = Diff1 > 30, + start_service(Name), + true = wait_for_node(Name), + T2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + remove_service(Name), + Diff2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T2, + true = Diff2 > 30, ok. -service_prio(doc) -> - ["Check that a service with higher prio create port programs with " - "higher prio."]; -service_prio(suite) -> []; + +%% Check that a service with higher prio create port programs with +%% higher prio. service_prio(Config) when is_list(Config) -> - ?line Name = "test_service_6", - ?line Service = [{servicename,Name},{prio,"high"}, - {env, [{"HEART_COMMAND","echo off"}]}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie()), - "-heart"]}], - ?line ok = erlsrv:store_service(Service), - ?line {ok, OldProcs} = get_current_procs(Config), - ?line start_service(Name), - ?line {ok, NewProcs} = get_current_procs(Config), + Name = "test_service_6", + Service = [{servicename,Name},{prio,"high"}, + {env, [{"HEART_COMMAND","echo off"}]}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie()), + "-heart"]}], + ok = erlsrv:store_service(Service), + {ok, OldProcs} = get_current_procs(Config), + start_service(Name), + {ok, NewProcs} = get_current_procs(Config), timer:sleep(2000), - ?line {ok, NewProcs2} = get_current_procs(Config), - ?line remove_service(Name), - ?line Diff = arrived_procs(OldProcs,NewProcs), + {ok, NewProcs2} = get_current_procs(Config), + remove_service(Name), + Diff = arrived_procs(OldProcs,NewProcs), io:format("NewProcs ~p~n after sleep~n ~p~n",[Diff, arrived_procs(OldProcs,NewProcs2)]), %% Not really correct, could fail if another heart is %% started at the same time... - ?line {value, {"heart.exe",_,"high"}} = - lists:keysearch("heart.exe",1,Diff), + {value, {"heart.exe",_,"high"}} = lists:keysearch("heart.exe",1,Diff), ok. -logout(doc) -> - ["Check that logout does not kill services"]; -logout(suite) -> []; + +%% Check that logout does not kill services logout(Config) when is_list(Config) -> - ?line {comment, "Have to be run manually by registering a service with " ++ - "heart, logout and log in again and then examine that the heart " ++ - "process id is not changed."}. -debug(doc) -> - ["Check the debug options to erlsrv."]; -debug(suite) -> []; + {comment, "Have to be run manually by registering a service with " ++ + "heart, logout and log in again and then examine that the heart " ++ + "process id is not changed."}. + +%% Check the debug options to erlsrv. debug(Config) when is_list(Config) -> - ?line Name0 = "test_service_7", + Name0 = "test_service_7", %% We used to set the privdir as temporary directory, but for some %% reason we don't seem to have write access to that directory, %% so we'll use the directory specified in the next line. - ?line TempDir = "C:/TEMP", - ?line Service0 = [{servicename,Name0}, - {workdir,filename:nativename(TempDir)}, - {debugtype,"reuse"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service0), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:local_time()), + TempDir = "C:/TEMP", + Service0 = [{servicename,Name0}, + {workdir,filename:nativename(TempDir)}, + {debugtype,"reuse"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service0), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), %% sleep a little - ?line receive after 2000 -> ok end, - ?line start_service(Name0), - ?line true = wait_for_node(Name0), - ?line LF = filename:join(TempDir, Name0++".debug"), - ?line {ok,Info0} = file:read_file_info(LF), - ?line T2 = calendar:datetime_to_gregorian_seconds( - Info0#file_info.mtime), - ?line true = T2 > T1, - ?line remove_service(Name0), - ?line file:delete(LF), - ?line Name1 = "test_service_8", - ?line Service1 = [{servicename,Name1}, - {workdir, filename:nativename(TempDir)}, - {debugtype,"new"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service1), - ?line T3 = calendar:datetime_to_gregorian_seconds( - calendar:local_time()), + receive after 2000 -> ok end, + start_service(Name0), + true = wait_for_node(Name0), + LF = filename:join(TempDir, Name0++".debug"), + {ok,Info0} = file:read_file_info(LF), + T2 = calendar:datetime_to_gregorian_seconds( + Info0#file_info.mtime), + true = T2 > T1, + remove_service(Name0), + file:delete(LF), + Name1 = "test_service_8", + Service1 = [{servicename,Name1}, + {workdir, filename:nativename(TempDir)}, + {debugtype,"new"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service1), + T3 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), %% sleep a little - ?line receive after 2000 -> ok end, - ?line NF = next_logfile(TempDir, Name1), - ?line start_service(Name1), - ?line true = wait_for_node(Name1), - ?line {ok,Info1} = file:read_file_info(NF), - ?line T4 = calendar:datetime_to_gregorian_seconds( - Info1#file_info.mtime), - ?line true = T4 > T3, - ?line remove_service(Name1), - ?line file:delete(NF), + receive after 2000 -> ok end, + NF = next_logfile(TempDir, Name1), + start_service(Name1), + true = wait_for_node(Name1), + {ok,Info1} = file:read_file_info(NF), + T4 = calendar:datetime_to_gregorian_seconds( + Info1#file_info.mtime), + true = T4 > T3, + remove_service(Name1), + file:delete(NF), ok. -restart(doc) -> - ["Check the restart options to erlsrv"]; -restart(suite) -> []; +%% Check the restart options to erlsrv restart(Config) when is_list(Config) -> - ?line Name = "test_service_9", - ?line Service = [{servicename,Name}, - {workdir, filename:nativename(logdir(Config))}, - {onfail,"restart"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line receive after 20000 -> ok end, - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line false = wait_for_node(Name), - ?line remove_service(Name), + Name = "test_service_9", + Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + receive after 20000 -> ok end, + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + false = wait_for_node(Name), + remove_service(Name), ok. -restart_always(doc) -> - ["Check the restart options to erlsrv"]; -restart_always(suite) -> []; +%% Check the restart options to erlsrv restart_always(Config) when is_list(Config) -> - ?line Name = "test_service_10", - ?line Service = [{servicename,Name}, - {workdir, filename:nativename(logdir(Config))}, - {onfail,"restart_always"}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line rpc:call(make_full_name(Name),erlang,halt,[]), - ?line receive after 1000 -> ok end, - ?line true = wait_for_node(Name), - ?line remove_service(Name), + Name = "test_service_10", + Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart_always"}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + rpc:call(make_full_name(Name),erlang,halt,[]), + receive after 1000 -> ok end, + true = wait_for_node(Name), + remove_service(Name), ok. -stopaction(doc) -> - ["Check that stopaction does not hang output while shutting down"]; -stopaction(suite) -> []; + +%% Check that stopaction does not hang output while shutting down stopaction(Config) when is_list(Config) -> - ?line Name = "test_service_11", + Name = "test_service_11", %% Icky, I prepend the first element in the codepath, cause %% I "suppose" it's the one to where I am. - ?line Service = [{servicename,Name}, - {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."}, - {args, ["-setcookie", - atom_to_list(erlang:get_cookie()), - "-pa", hd(code:get_path())]}], - ?line ok = erlsrv:store_service(Service), - ?line start_service(Name), - ?line true = wait_for_node(Name), - ?line T1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()), - ?line stop_service(Name), - ?line Diff1 = calendar:datetime_to_gregorian_seconds( - calendar:universal_time()) - T1, - ?line true = Diff1 < 30, - ?line remove_service(Name), + Service = [{servicename,Name}, + {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."}, + {args, ["-setcookie", atom_to_list(erlang:get_cookie()), + "-pa", hd(code:get_path())]}], + ok = erlsrv:store_service(Service), + start_service(Name), + true = wait_for_node(Name), + T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + stop_service(Name), + Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + true = Diff1 < 30, + remove_service(Name), ok. %%% This test is run on all platforms, but just gives a comment on %%% other platforms than NT. -nt(doc) -> - ["Run NT specific tests."]; -nt(suite) -> - []; nt(Config) when is_list(Config) -> case os:type() of - {win32,nt} -> - nt_run(); - _ -> - {skipped, "This test case is intended for Win NT only."} + {win32,nt} -> + nt_run(); + _ -> + {skipped, "This test case is intended for Win NT only."} end. nt_run() -> - ?line start_all(), - ?line create_service("test_service_1"), - ?line R = start_look_for_single("System","ErlSrv","Informational", - ".*test_service_1.*started.*"), - ?line start_service("test_service_1"), - ?line Res = look_for_single(R), - ?line io:format("Result from eventlog: ~p~n", - [Res]), - ?line remove_service("test_service_1"), - ?line stop_all(), + start_all(), + create_service("test_service_1"), + R = start_look_for_single("System","ErlSrv","Informational", + ".*test_service_1.*started.*"), + start_service("test_service_1"), + Res = look_for_single(R), + io:format("Result from eventlog: ~p~n", + [Res]), + remove_service("test_service_1"), + stop_all(), ok. start_all() -> Pid1 = spawn_link(?MODULE,middleman,[[]]), register(?MODULE,Pid1), _Pid2 = nteventlog:start("log_testing", - {?MODULE,handle_eventlog,[Pid1]}). + {?MODULE,handle_eventlog,[Pid1]}). stop_all() -> ?MODULE ! stop, @@ -454,10 +405,10 @@ start_look_for_single(Cat,Fac,Sev,MessRE) -> look_for_single(Ref) -> receive - {Ref,Time,Mes} -> - {Time,Mes} + {Ref,Time,Mes} -> + {Time,Mes} after 60000 -> - timeout + timeout end. @@ -468,25 +419,25 @@ handle_eventlog(Mes,Pid) -> %%% Waitfor = [{Pid, Ref, {Category,Facility,Severity,MessageRE}} ...] middleman(Waitfor) -> receive - {Time,Category,Facility,Severity,Message} -> - io:format("Middleman got ~s...", [Message]), - case match_event({Time,Category,Facility,Severity,Message}, - Waitfor) of - {ok, {Pid,Ref,Time,Mes}, Rest} -> - io:format("matched~n"), - Pid ! {Ref,Time,Mes}, - middleman(Rest); - _ -> - io:format("no match~n"), - middleman(Waitfor) - end; - {lookfor, X} -> - io:format("Middleman told to look for ~p~n", [X]), - middleman([X|Waitfor]); - stop -> - stopped; - _ -> - middleman(Waitfor) + {Time,Category,Facility,Severity,Message} -> + io:format("Middleman got ~s...", [Message]), + case match_event({Time,Category,Facility,Severity,Message}, + Waitfor) of + {ok, {Pid,Ref,Time,Mes}, Rest} -> + io:format("matched~n"), + Pid ! {Ref,Time,Mes}, + middleman(Rest); + _ -> + io:format("no match~n"), + middleman(Waitfor) + end; + {lookfor, X} -> + io:format("Middleman told to look for ~p~n", [X]), + middleman([X|Waitfor]); + stop -> + stopped; + _ -> + middleman(Waitfor) end. @@ -495,81 +446,81 @@ match_event(_X, []) -> nomatch; match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) -> case re:run(Mes,MesRE,[{capture,none}]) of - match -> - %%io:format("Match!~n"), - {ok,{Pid,Ref,Time,Mes},Tail}; - nomatch -> - %%io:format("No match~n"), - case match_event({Time,Cat,Fac,Sev,Mes},Tail) of - {ok,X,Rest} -> - {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; - X -> - X - end + match -> + %%io:format("Match!~n"), + {ok,{Pid,Ref,Time,Mes},Tail}; + nomatch -> + %%io:format("No match~n"), + case match_event({Time,Cat,Fac,Sev,Mes},Tail) of + {ok,X,Rest} -> + {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; + X -> + X + end end; match_event(X,[Y | T]) -> %%io:format("X == ~p, Y == ~p~n",[X,Y]), case match_event(X,T) of - {ok,Z,R} -> - {ok,Z,[Y|R]}; - XX -> - XX + {ok,Z,R} -> + {ok,Z,[Y|R]}; + XX -> + XX end. arrived_procs(_,[]) -> []; arrived_procs(OldProcs,[{Executable, Pid, Priority} | TNewProcs]) -> case lists:keysearch(Pid,2,OldProcs) of - {value, _} -> - arrived_procs(OldProcs, TNewProcs); - false -> - [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)] + {value, _} -> + arrived_procs(OldProcs, TNewProcs); + false -> + [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)] end. - + get_current_procs(Config) -> - ?line P = open_port({spawn,nt_info(Config) ++ " -E"}, - [{line,10000}]), - ?line L = receive - {P,{data,{eol,D}}} -> - D; - _ -> "error. " - end, - ?line P ! {self(), close}, - ?line receive - {P, closed} -> ok - end, - ?line {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0), - ?line erl_parse:parse_term(Tok). + P = open_port({spawn,nt_info(Config) ++ " -E"}, + [{line,10000}]), + L = receive + {P,{data,{eol,D}}} -> + D; + _ -> "error. " + end, + P ! {self(), close}, + receive + {P, closed} -> ok + end, + {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0), + erl_parse:parse_term(Tok). nt_info(Config) when is_list(Config) -> - ?line "\"" ++ filename:join(?config(data_dir, Config), "nt_info") ++ "\"". + "\"" ++ filename:join(proplists:get_value(data_dir, Config), "nt_info") ++ "\"". logdir(Config) -> - ?line ?config(priv_dir, Config). + proplists:get_value(priv_dir, Config). look_for_next(Template,L,N) -> - ?line FN = Template ++ integer_to_list(N), - ?line case lists:member(FN,L) of - true -> - ?line look_for_next(Template,L,N+1); - false -> - ?line FN + FN = Template ++ integer_to_list(N), + case lists:member(FN,L) of + true -> + look_for_next(Template,L,N+1); + false -> + FN end. next_logfile(LD, Servicename) -> - ?line {ok, Files} = file:list_dir(LD), - ?line Ftmpl = Servicename ++ ".debug.", - ?line filename:join(LD,look_for_next(Ftmpl,Files,1)). + {ok, Files} = file:list_dir(LD), + Ftmpl = Servicename ++ ".debug.", + filename:join(LD,look_for_next(Ftmpl,Files,1)). %%% Functions run by the service do_shutdown_io() -> receive after 2000 -> - io:format("IO in shutting down...~n"), - erlang:halt() + io:format("IO in shutting down...~n"), + erlang:halt() end. shutdown_io() -> diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl index 2efb5ae200..7ca0f50263 100644 --- a/erts/test/otp_SUITE.erl +++ b/erts/test/otp_SUITE.erl @@ -20,18 +20,20 @@ -module(otp_SUITE). --export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, - init_per_suite/1,end_per_suite/1]). +-export([all/0, suite/0, + init_per_suite/1,end_per_suite/1]). -export([undefined_functions/1,deprecated_not_in_obsolete/1, - obsolete_but_not_deprecated/1,call_to_deprecated/1, + obsolete_but_not_deprecated/1,call_to_deprecated/1, call_to_size_1/1,call_to_now_0/1,strong_components/1, - erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). + erl_file_encoding/1,xml_file_encoding/1,runtime_dependencies/1]). -include_lib("common_test/include/ct.hrl"). -import(lists, [filter/2,foldl/3,foreach/2]). -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 10}}]. all() -> [undefined_functions, deprecated_not_in_obsolete, @@ -40,54 +42,41 @@ all() -> erl_file_encoding, xml_file_encoding, runtime_dependencies]. -groups() -> - []. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - init_per_suite(Config) -> - Dog = test_server:timetrap(?t:minutes(10)), Root = code:root_dir(), Server = daily_xref, - ?line xref:start(Server), - ?line xref:set_default(Server, [{verbose,false}, - {warnings,false}, - {builtins,true}]), - ?line {ok,_Relname} = xref:add_release(Server, Root, {name,otp}), + xref:start(Server), + xref:set_default(Server, [{verbose,false}, + {warnings,false}, + {builtins,true}]), + {ok,_Relname} = xref:add_release(Server, Root, {name,otp}), %% If we are running the tests in the source tree, the ERTS application %% is not in the code path. We must add it explicitly. case code:lib_dir(erts) of - {error,bad_name} -> - Erts = filename:join([code:root_dir(),"erts","preloaded","ebin"]), - ?line {ok,_} = xref:add_directory(Server, Erts, []); - _ -> - ok + {error,bad_name} -> + Erts = filename:join([code:root_dir(),"erts","preloaded","ebin"]), + {ok,_} = xref:add_directory(Server, Erts, []); + _ -> + ok end, - - ?line ?t:timetrap_cancel(Dog), [{xref_server,Server}|Config]. end_per_suite(Config) -> - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), catch xref:stop(Server), Config. undefined_functions(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), %% Exclude calls from generated modules in the SSL application. ExcludeFrom = "SSL-PKIX|PKIX.*|ssl_pkix_oid", - ?line UndefS = xref_base:analysis(undefined_function_calls), - ?line Q = io_lib:format("Undef = ~s," - "ExcludedFrom = ~p:_/_," - "Undef - Undef | ExcludedFrom", - [UndefS,ExcludeFrom]), + UndefS = xref_base:analysis(undefined_function_calls), + Q = io_lib:format("Undef = ~s," + "ExcludedFrom = ~p:_/_," + "Undef - Undef | ExcludedFrom", + [UndefS,ExcludeFrom]), {ok,Undef0} = xref:q(Server, lists:flatten(Q)), Undef1 = hipe_filter(Undef0), Undef2 = ssl_crypto_filter(Undef1), @@ -99,124 +88,124 @@ undefined_functions(Config) when is_list(Config) -> Undef = diameter_filter(Undef7), case Undef of - [] -> ok; - _ -> - Fd = open_log(Config, "undefined_functions"), - foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(Server, MFA1), - format_mfa(MFA2)]), - io:format(Fd, "~s ~s\n", - [format_mfa(Server, MFA1), - format_mfa(MFA2)]) - end, Undef), - close_log(Fd), - ?line ?t:fail({length(Undef),undefined_functions_in_otp}) + [] -> ok; + _ -> + Fd = open_log(Config, "undefined_functions"), + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(Server, MFA1), + format_mfa(MFA2)]), + io:format(Fd, "~s ~s\n", + [format_mfa(Server, MFA1), + format_mfa(MFA2)]) + end, Undef), + close_log(Fd), + ct:fail({length(Undef),undefined_functions_in_otp}) end. hipe_filter(Undef) -> case erlang:system_info(hipe_architecture) of - undefined -> - filter(fun ({_,{hipe_bifs,_,_}}) -> false; - ({_,{hipe,_,_}}) -> false; - ({_,{hipe_consttab,_,_}}) -> false; - ({_,{hipe_converters,_,_}}) -> false; - ({{code,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{code_server,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{compile,_,_},{Mod,_,_}}) -> - not is_hipe_module(Mod); - ({{hipe,_,_},{Mod,_,_}}) -> - %% See comment for the next clause. - not is_hipe_module(Mod); - ({{cerl_to_icode,translate_flags1,2}, - {hipe_rtl_arch,endianess,0}}) -> - false; - ({{Caller,_,_},{Callee,_,_}}) -> - %% Part of the hipe application is here - %% for the sake of Dialyzer. There are many - %% undefined calls within the hipe application. - not is_hipe_module(Caller) orelse - not is_hipe_module(Callee); - (_) -> true - end, Undef); - _Arch -> - filter(fun ({{Mod,_,_},{hipe_bifs,write_u64,2}}) -> - %% Unavailable except in 64 bit AMD. Ignore it. - not is_hipe_module(Mod); - (_) -> true - end, Undef) + undefined -> + filter(fun ({_,{hipe_bifs,_,_}}) -> false; + ({_,{hipe,_,_}}) -> false; + ({_,{hipe_consttab,_,_}}) -> false; + ({_,{hipe_converters,_,_}}) -> false; + ({{code,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{code_server,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{compile,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{hipe,_,_},{Mod,_,_}}) -> + %% See comment for the next clause. + not is_hipe_module(Mod); + ({{cerl_to_icode,translate_flags1,2}, + {hipe_rtl_arch,endianess,0}}) -> + false; + ({{Caller,_,_},{Callee,_,_}}) -> + %% Part of the hipe application is here + %% for the sake of Dialyzer. There are many + %% undefined calls within the hipe application. + not is_hipe_module(Caller) orelse + not is_hipe_module(Callee); + (_) -> true + end, Undef); + _Arch -> + filter(fun ({{Mod,_,_},{hipe_bifs,write_u64,2}}) -> + %% Unavailable except in 64 bit AMD. Ignore it. + not is_hipe_module(Mod); + (_) -> true + end, Undef) end. is_hipe_module(Mod) -> case atom_to_list(Mod) of - "hipe_"++_ -> true; - _ -> false + "hipe_"++_ -> true; + _ -> false end. ssl_crypto_filter(Undef) -> case {app_exists(crypto),app_exists(ssl)} of - {false,false} -> - filter(fun({_,{ssl,_,_}}) -> false; - ({_,{crypto,_,_}}) -> false; - ({_,{ssh,_,_}}) -> false; - ({_,{ssh_connection,_,_}}) -> false; - ({_,{ssh_sftp,_,_}}) -> false; - (_) -> true - end, Undef); - {_,_} -> Undef + {false,false} -> + filter(fun({_,{ssl,_,_}}) -> false; + ({_,{crypto,_,_}}) -> false; + ({_,{ssh,_,_}}) -> false; + ({_,{ssh_connection,_,_}}) -> false; + ({_,{ssh_sftp,_,_}}) -> false; + (_) -> true + end, Undef); + {_,_} -> Undef end. edoc_filter(Undef) -> %% Filter away function call that is catched. filter(fun({{edoc_lib,uri_get_http,1},{http,request_sync,2}}) -> false; - (_) -> true - end, Undef). + (_) -> true + end, Undef). eunit_filter(Undef) -> filter(fun({{eunit_test,wrapper_test_exported_,0}, - {eunit_test,nonexisting_function,0}}) -> false; - (_) -> true - end, Undef). + {eunit_test,nonexisting_function,0}}) -> false; + (_) -> true + end, Undef). dialyzer_filter(Undef) -> case app_exists(dialyzer) of - false -> - filter(fun({_,{dialyzer_callgraph,_,_}}) -> false; - ({_,{dialyzer_codeserver,_,_}}) -> false; - ({_,{dialyzer_contracts,_,_}}) -> false; - ({_,{dialyzer_cl_parse,_,_}}) -> false; - ({_,{dialyzer_timing,_,_}}) -> false; - ({_,{dialyzer_plt,_,_}}) -> false; - ({_,{dialyzer_succ_typings,_,_}}) -> false; - ({_,{dialyzer_utils,_,_}}) -> false; - (_) -> true - end, Undef); - _ -> Undef + false -> + filter(fun({_,{dialyzer_callgraph,_,_}}) -> false; + ({_,{dialyzer_codeserver,_,_}}) -> false; + ({_,{dialyzer_contracts,_,_}}) -> false; + ({_,{dialyzer_cl_parse,_,_}}) -> false; + ({_,{dialyzer_timing,_,_}}) -> false; + ({_,{dialyzer_plt,_,_}}) -> false; + ({_,{dialyzer_succ_typings,_,_}}) -> false; + ({_,{dialyzer_utils,_,_}}) -> false; + (_) -> true + end, Undef); + _ -> Undef end. wx_filter(Undef) -> case app_exists(wx) of - false -> - filter(fun({_,{MaybeWxModule,_,_}}) -> - case atom_to_list(MaybeWxModule) of - "wx"++_ -> false; - _ -> true - end - end, Undef); - _ -> Undef + false -> + filter(fun({_,{MaybeWxModule,_,_}}) -> + case atom_to_list(MaybeWxModule) of + "wx"++_ -> false; + _ -> true + end + end, Undef); + _ -> Undef end. - + gs_filter(Undef) -> case code:lib_dir(gs) of - {error,bad_name} -> - filter(fun({_,{gs,_,_}}) -> false; - ({_,{gse,_,_}}) -> false; + {error,bad_name} -> + filter(fun({_,{gs,_,_}}) -> false; + ({_,{gse,_,_}}) -> false; ({_,{tool_utils,_,_}}) -> false; - (_) -> true - end, Undef); - _ -> Undef + (_) -> true + end, Undef); + _ -> Undef end. diameter_filter(Undef) -> @@ -229,80 +218,80 @@ diameter_filter(Undef) -> false; ({{diameter_lib,_,_},{erlang,time_offset,0}}) -> false; - (_) -> true - end, Undef). + (_) -> true + end, Undef). deprecated_not_in_obsolete(Config) when is_list(Config) -> - ?line Server = ?config(xref_server, Config), - ?line {ok,DeprecatedFunctions} = xref:q(Server, "DF"), - - ?line L = foldl(fun({M,F,A}=MFA, Acc) -> - case otp_internal:obsolete(M, F, A) of - no -> [MFA|Acc]; - _ -> Acc - end - end, [], DeprecatedFunctions), + Server = proplists:get_value(xref_server, Config), + {ok,DeprecatedFunctions} = xref:q(Server, "DF"), + + L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> [MFA|Acc]; + _ -> Acc + end + end, [], DeprecatedFunctions), case L of - [] -> ok; - _ -> - io:put_chars("The following functions have -deprecated() attributes,\n" - "but are not listed in otp_internal:obsolete/3.\n"), - print_mfas(group_leader(), Server, L), - Fd = open_log(Config, "deprecated_not_obsolete"), - print_mfas(Fd, Server, L), - close_log(Fd), - ?line ?t:fail({length(L),deprecated_but_not_obsolete}) + [] -> ok; + _ -> + io:put_chars("The following functions have -deprecated() attributes,\n" + "but are not listed in otp_internal:obsolete/3.\n"), + print_mfas(group_leader(), Server, L), + Fd = open_log(Config, "deprecated_not_obsolete"), + print_mfas(Fd, Server, L), + close_log(Fd), + ct:fail({length(L),deprecated_but_not_obsolete}) end. obsolete_but_not_deprecated(Config) when is_list(Config) -> - ?line Server = ?config(xref_server, Config), - ?line {ok,NotDeprecated} = xref:q(Server, "X - DF"), + Server = proplists:get_value(xref_server, Config), + {ok,NotDeprecated} = xref:q(Server, "X - DF"), - ?line L = foldl(fun({M,F,A}=MFA, Acc) -> - case otp_internal:obsolete(M, F, A) of - no -> Acc; - _ -> [MFA|Acc] - end - end, [], NotDeprecated), + L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> Acc; + _ -> [MFA|Acc] + end + end, [], NotDeprecated), case L of - [] -> ok; - _ -> - io:put_chars("The following functions are listed " - "in otp_internal:obsolete/3,\n" - "but don't have -deprecated() attributes.\n"), - print_mfas(group_leader(), Server, L), - Fd = open_log(Config, "obsolete_not_deprecated"), - print_mfas(Fd, Server, L), - close_log(Fd), - ?line ?t:fail({length(L),obsolete_but_not_deprecated}) + [] -> ok; + _ -> + io:put_chars("The following functions are listed " + "in otp_internal:obsolete/3,\n" + "but don't have -deprecated() attributes.\n"), + print_mfas(group_leader(), Server, L), + Fd = open_log(Config, "obsolete_not_deprecated"), + print_mfas(Fd, Server, L), + close_log(Fd), + ct:fail({length(L),obsolete_but_not_deprecated}) end. - + call_to_deprecated(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), - ?line {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), + Server = proplists:get_value(xref_server, Config), + {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls deprecated ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, DeprecatedCalls), + io:format("~s calls deprecated ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, DeprecatedCalls), {comment,integer_to_list(length(DeprecatedCalls))++" calls to deprecated functions"}. call_to_size_1(Config) when is_list(Config) -> %% Applications that do not call erlang:size/1: Apps = [asn1,compiler,debugger,kernel,observer,parsetools, - runtime_tools,stdlib,tools], + runtime_tools,stdlib,tools], not_recommended_calls(Config, Apps, {erlang,size,1}). call_to_now_0(Config) when is_list(Config) -> %% Applications that do not call erlang:now/1: Apps = [asn1,common_test,compiler,debugger,dialyzer, - gs,kernel,mnesia,observer,parsetools,reltool, - runtime_tools,sasl,stdlib,syntax_tools, - tools], + gs,kernel,mnesia,observer,parsetools,reltool, + runtime_tools,sasl,stdlib,syntax_tools, + tools], not_recommended_calls(Config, Apps, {erlang,now,0}). not_recommended_calls(Config, Apps0, MFA) -> - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), Apps = [App || App <- Apps0, is_present_application(App, Server)], @@ -315,14 +304,14 @@ not_recommended_calls(Config, Apps0, MFA) -> {ok,CallsToMFA} = xref:q(Server, lists:flatten(Q2)), case CallsToMFA of - [] -> + [] -> ok; - _ -> + _ -> io:format("These calls are not allowed:\n"), - foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls non-recommended ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, CallsToMFA) + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls non-recommended ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, CallsToMFA) end, %% Enumerate calls to MFA from other applications than @@ -338,7 +327,7 @@ not_recommended_calls(Config, Apps0, MFA) -> end, Calls) end, case CallsToMFA of - [] -> + [] -> SkippedApps = ordsets:subtract(ordsets:from_list(Apps0), ordsets:from_list(Apps)), case SkippedApps of @@ -350,8 +339,8 @@ not_recommended_calls(Config, Apps0, MFA) -> [string:join(AppStrings, ", ")]), {comment, Mess} end; - _ -> - ?t:fail({length(CallsToMFA),calls_to_size_1}) + _ -> + ct:fail({length(CallsToMFA),calls_to_size_1}) end. is_present_application(Name, Server) -> @@ -362,8 +351,8 @@ is_present_application(Name, Server) -> end. strong_components(Config) when is_list(Config) -> - Server = ?config(xref_server, Config), - ?line {ok,Cs} = xref:q(Server, "components AE"), + Server = proplists:get_value(xref_server, Config), + {ok,Cs} = xref:q(Server, "components AE"), io:format("\n\nStrong components:\n\n~p\n", [Cs]), ok. @@ -371,41 +360,41 @@ erl_file_encoding(_Config) -> Root = code:root_dir(), Wc = filename:join([Root,"**","*.erl"]), ErlFiles = ordsets:subtract(ordsets:from_list(filelib:wildcard(Wc)), - release_files(Root, "*.erl")), + release_files(Root, "*.erl")), {ok, MP} = re:compile(".*lib/(ic)|(orber)|(cos).*", [unicode]), Fs = [F || F <- ErlFiles, - filter_use_latin1_coding(F, MP), - case epp:read_encoding(F) of - none -> false; - _ -> true - end], + filter_use_latin1_coding(F, MP), + case epp:read_encoding(F) of + none -> false; + _ -> true + end], case Fs of - [] -> - ok; - [_|_] -> - io:put_chars("Files with \"coding:\":\n"), - [io:put_chars(F) || F <- Fs], - ?t:fail() + [] -> + ok; + [_|_] -> + io:put_chars("Files with \"coding:\":\n"), + [io:put_chars(F) || F <- Fs], + ct:fail(failed) end. filter_use_latin1_coding(F, MP) -> case re:run(F, MP) of - nomatch -> - true; + nomatch -> + true; {match, _} -> - false + false end. xml_file_encoding(_Config) -> XmlFiles = xml_files(), Fs = [F || F <- XmlFiles, is_bad_encoding(F)], case Fs of - [] -> - ok; - [_|_] -> - io:put_chars("Encoding should be \"utf-8\" or \"UTF-8\":\n"), - [io:put_chars(F) || F <- Fs], - ?t:fail() + [] -> + ok; + [_|_] -> + io:put_chars("Encoding should be \"utf-8\" or \"UTF-8\":\n"), + [io:put_chars(F) || F <- Fs], + ct:fail(failed) end. xml_files() -> @@ -417,7 +406,7 @@ xml_files() -> XmerlWc = filename:join([Root,"lib","xmerl","**","*.xml"]), XmerlXmlFiles = ordsets:from_list(filelib:wildcard(XmerlWc)), Ignore = ordsets:union([TestXmlFiles,XmerlXmlFiles, - release_files(Root, "*.xml")]), + release_files(Root, "*.xml")]), ordsets:subtract(AllXmlFiles, Ignore). release_files(Root, Ext) -> @@ -427,12 +416,12 @@ release_files(Root, Ext) -> is_bad_encoding(File) -> {ok,Bin} = file:read_file(File), case Bin of - <<"<?xml version=\"1.0\" encoding=\"utf-8\"",_/binary>> -> - false; - <<"<?xml version=\"1.0\" encoding=\"UTF-8\"",_/binary>> -> - false; - _ -> - true + <<"<?xml version=\"1.0\" encoding=\"utf-8\"",_/binary>> -> + false; + <<"<?xml version=\"1.0\" encoding=\"UTF-8\"",_/binary>> -> + false; + _ -> + true end. runtime_dependencies(Config) -> @@ -444,31 +433,31 @@ runtime_dependencies(Config) -> %% Verify that (at least) OTP application runtime dependencies found %% by xref are listed in the runtime_dependencies field of the .app file %% of each application. - Server = ?config(xref_server, Config), + Server = proplists:get_value(xref_server, Config), {ok, AE} = xref:q(Server, "AE"), SAE = lists:keysort(1, AE), put(ignored_failures, []), {AppDep, AppDeps} = lists:foldl(fun ({App, App}, Acc) -> - Acc; - ({App, Dep}, {undefined, []}) -> - {{App, [Dep]}, []}; - ({App, Dep}, {{App, Deps}, AppDeps}) -> - {{App, [Dep|Deps]}, AppDeps}; - ({App, Dep}, {AppDep, AppDeps}) -> - {{App, [Dep]}, [AppDep | AppDeps]} - end, - {undefined, []}, - SAE), + Acc; + ({App, Dep}, {undefined, []}) -> + {{App, [Dep]}, []}; + ({App, Dep}, {{App, Deps}, AppDeps}) -> + {{App, [Dep|Deps]}, AppDeps}; + ({App, Dep}, {AppDep, AppDeps}) -> + {{App, [Dep]}, [AppDep | AppDeps]} + end, + {undefined, []}, + SAE), check_apps_deps([AppDep|AppDeps], IgnoreApps), case IgnoreApps of - [] -> - ok; - _ -> - Comment = lists:flatten(io_lib:format("Ignored applications: ~p " - "Ignored failures: ~p", - [IgnoreApps, - get(ignored_failures)])), - {comment, Comment} + [] -> + ok; + _ -> + Comment = lists:flatten(io_lib:format("Ignored applications: ~p " + "Ignored failures: ~p", + [IgnoreApps, + get(ignored_failures)])), + {comment, Comment} end. have_rdep(_App, [], _Dep) -> @@ -476,11 +465,11 @@ have_rdep(_App, [], _Dep) -> have_rdep(App, [RDep | RDeps], Dep) -> [AppStr, _VsnStr] = string:tokens(RDep, "-"), case Dep == list_to_atom(AppStr) of - true -> - io:format("~p -> ~s~n", [App, RDep]), - true; - false -> - have_rdep(App, RDeps, Dep) + true -> + io:format("~p -> ~s~n", [App, RDep]), + true; + false -> + have_rdep(App, RDeps, Dep) end. check_app_deps(_App, _AppFile, _AFDeps, [], _IgnoreApps) -> @@ -488,17 +477,17 @@ check_app_deps(_App, _AppFile, _AFDeps, [], _IgnoreApps) -> check_app_deps(App, AppFile, AFDeps, [XRDep | XRDeps], IgnoreApps) -> ResOtherDeps = check_app_deps(App, AppFile, AFDeps, XRDeps, IgnoreApps), case have_rdep(App, AFDeps, XRDep) of - true -> - ResOtherDeps; - false -> - Failure = {missing_runtime_dependency, AppFile, XRDep}, - case lists:member(App, IgnoreApps) of - true -> - put(ignored_failures, [Failure | get(ignored_failures)]), - ResOtherDeps; - false -> - [Failure | ResOtherDeps] - end + true -> + ResOtherDeps; + false -> + Failure = {missing_runtime_dependency, AppFile, XRDep}, + case lists:member(App, IgnoreApps) of + true -> + put(ignored_failures, [Failure | get(ignored_failures)]), + ResOtherDeps; + false -> + [Failure | ResOtherDeps] + end end. check_apps_deps([], _IgnoreApps) -> @@ -508,24 +497,24 @@ check_apps_deps([{App, Deps}|AppDeps], IgnoreApps) -> AppFile = code:where_is_file(atom_to_list(App) ++ ".app"), {ok,[{application, App, Info}]} = file:consult(AppFile), case lists:keyfind(runtime_dependencies, 1, Info) of - {runtime_dependencies, RDeps} -> - check_app_deps(App, AppFile, RDeps, Deps, IgnoreApps) - ++ ResOtherApps; - false -> - Failure = {missing_runtime_dependencies_key, AppFile}, - case lists:member(App, IgnoreApps) of - true -> - put(ignored_failures, [Failure | get(ignored_failures)]), - ResOtherApps; - false -> - [Failure | ResOtherApps] - end + {runtime_dependencies, RDeps} -> + check_app_deps(App, AppFile, RDeps, Deps, IgnoreApps) + ++ ResOtherApps; + false -> + Failure = {missing_runtime_dependencies_key, AppFile}, + case lists:member(App, IgnoreApps) of + true -> + put(ignored_failures, [Failure | get(ignored_failures)]), + ResOtherApps; + false -> + [Failure | ResOtherApps] + end end. %%% %%% Common help functions. %%% - + print_mfas(Fd, Server, MFAs) -> [io:format(Fd, "~s\n", [format_mfa(Server, MFA)]) || MFA <- MFAs], ok. @@ -537,13 +526,13 @@ format_mfa(Server, MFA) -> MFAString = format_mfa(MFA), AQ = "(App)" ++ MFAString, AppPrefix = case xref:q(Server, AQ) of - {ok,[App]} -> "[" ++ atom_to_list(App) ++ "]"; - _ -> "" - end, + {ok,[App]} -> "[" ++ atom_to_list(App) ++ "]"; + _ -> "" + end, AppPrefix ++ MFAString. open_log(Config, Name) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), RunDir = filename:dirname(filename:dirname(PrivDir)), Path = filename:join(RunDir, "system_"++Name++".log"), {ok,Fd} = file:open(Path, [write]), @@ -554,13 +543,13 @@ close_log(Fd) -> app_exists(AppAtom) -> case code:lib_dir(AppAtom) of - {error,bad_name} -> - false; - Path -> - case file:read_file_info(filename:join(Path,"ebin")) of - {ok,_} -> - true; - _ -> - false - end + {error,bad_name} -> + false; + Path -> + case file:read_file_info(filename:join(Path,"ebin")) of + {ok,_} -> + true; + _ -> + false + end end. diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl index e3c563d3d9..5cd0068280 100644 --- a/erts/test/run_erl_SUITE.erl +++ b/erts/test/run_erl_SUITE.erl @@ -20,43 +20,19 @@ -module(run_erl_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - basic/1,heavy/1,heavier/1,defunct/1]). +-export([all/0, suite/0]). +-export([basic/1,heavy/1,heavier/1,defunct/1]). -export([ping_me_back/1]). -include_lib("common_test/include/ct.hrl"). -init_per_testcase(_Case, Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 2}}]. all() -> [basic, heavy, heavier, defunct]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - basic(Config) when is_list(Config) -> case os:type() of @@ -65,16 +41,16 @@ basic(Config) when is_list(Config) -> end. basic_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "basic"), + {Node,Pipe} = do_run_erl(Config, "basic"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), - ?line erlang:port_command(ToErl, "halt().\r\n"), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), + erlang:port_command(ToErl, "halt().\r\n"), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, ok. @@ -86,29 +62,28 @@ heavy(Config) when is_list(Config) -> end. heavy_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "heavy"), + {Node,Pipe} = do_run_erl(Config, "heavy"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), IoFormat = "io:format(\"~s\n\", [lists:duplicate(10000, 10)]).\r\n", - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, IoFormat), - ?line erlang:port_command(ToErl, "init:stop().\r\n"), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, IoFormat), + erlang:port_command(ToErl, "init:stop().\r\n"), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, - ?line case count_new_lines(ToErl, 0) of - Nls when Nls > 30000 -> - ok; - Nls -> - ?line io:format("new_lines: ~p\n", [Nls]), - ?line ?t:fail() - end. + case count_new_lines(ToErl, 0) of + Nls when Nls > 30000 -> + ok; + Nls -> + ct:fail("new_lines: ~p\n", [Nls]) + end. ping_me_back([Node]) when is_atom(Node) -> @@ -137,16 +112,16 @@ heavier(Config) when is_list(Config) -> end. heavier_1(Config) -> - ?line {Node,Pipe} = do_run_erl(Config, "heavier"), + {Node,Pipe} = do_run_erl(Config, "heavier"), - ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + ToErl = open_port({spawn,"to_erl "++Pipe}, []), io:format("ToErl = ~p\n", [ToErl]), Seed = {1,555,42}, rand:seed(exsplus, Seed), SeedCmd = lists:flatten(io_lib:format("rand:seed(exsplus, ~p). \r\n", [Seed])), - ?line io:format("~p\n", [SeedCmd]), - ?line erlang:port_command(ToErl, SeedCmd), + io:format("~p\n", [SeedCmd]), + erlang:port_command(ToErl, SeedCmd), Iter = 1000, MaxLen = 2048, @@ -165,19 +140,19 @@ heavier_1(Config) -> "F(F,"++integer_to_list(Iter)++")."++" \r\n", - ?line io:format("~p\n", [Random]), - ?line erlang:port_command(ToErl, Random), + io:format("~p\n", [Random]), + erlang:port_command(ToErl, Random), %% Finish. - ?line erlang:port_command(ToErl, "init:stop().\r\n"), - ?line receive_all(Iter, ToErl, MaxLen), + erlang:port_command(ToErl, "init:stop().\r\n"), + receive_all(Iter, ToErl, MaxLen), receive {nodedown,Node} -> - ?line io:format("Down: ~p\n", [Node]) + io:format("Down: ~p\n", [Node]) after 10000 -> - ?line c:flush(), - ?line ?t:fail() + c:flush(), + ct:fail(timeout) end, ok. @@ -204,9 +179,7 @@ receive_all_2(Iter, {NumChars,Pattern}, Line0, ToErl, MaxLen) -> %%io:format("Recv: ~p\n", [S]), receive_all_2(Iter, {NumChars,Pattern}, Line++S, ToErl, MaxLen) after 10000 -> - io:format("Timeout waiting for\n~p\ngot\n~p\n", - [Pattern, Line]), - ?line ?t:fail() + ct:fail("Timeout waiting for\n~p\ngot\n~p\n", [Pattern, Line]) end end. @@ -241,49 +214,47 @@ defunct_1(Config) -> end. defunct_2(Config, Perl) -> - ?line Data = ?config(data_dir, Config), - ?line RunErlTest = filename:join(Data, "run_erl_test.pl"), - ?line Defuncter = filename:join(Data, "defuncter.pl"), - ?line Priv = ?config(priv_dir, Config), - ?line LogDir = filename:join(Priv, "defunct"), - ?line ok = file:make_dir(LogDir), - ?line Pipe = LogDir ++ "/", - ?line RunErl = os:find_executable(run_erl), - ?line Cmd = Perl ++ " " ++ RunErlTest ++ " \"" ++ RunErl ++ "\" " ++ + Data = proplists:get_value(data_dir, Config), + RunErlTest = filename:join(Data, "run_erl_test.pl"), + Defuncter = filename:join(Data, "defuncter.pl"), + Priv = proplists:get_value(priv_dir, Config), + LogDir = filename:join(Priv, "defunct"), + ok = file:make_dir(LogDir), + Pipe = LogDir ++ "/", + RunErl = os:find_executable(run_erl), + Cmd = Perl ++ " " ++ RunErlTest ++ " \"" ++ RunErl ++ "\" " ++ Defuncter ++ " " ++ Pipe ++ " " ++ LogDir, - ?line io:format("~p", [Cmd]), - ?line Res = os:cmd(Cmd), - ?line io:format("~p\n", [Res]), + io:format("~p", [Cmd]), + Res = os:cmd(Cmd), + io:format("~p\n", [Res]), "OK"++_ = Res, ok. %%% Utilities. do_run_erl(Config, Case) -> - ?line Priv = ?config(priv_dir, Config), - ?line LogDir = filename:join(Priv, Case), - ?line ok = file:make_dir(LogDir), - ?line Pipe = LogDir ++ "/", - ?line NodeName = "run_erl_node_" ++ Case, - ?line Cmd = "run_erl "++Pipe++" "++LogDir++" \"erl -sname " ++ NodeName ++ + Priv = proplists:get_value(priv_dir, Config), + LogDir = filename:join(Priv, Case), + ok = file:make_dir(LogDir), + Pipe = LogDir ++ "/", + NodeName = "run_erl_node_" ++ Case, + Cmd = "run_erl "++Pipe++" "++LogDir++" \"erl -sname " ++ NodeName ++ " -pa " ++ filename:dirname(code:which(?MODULE)) ++ " -s " ++ ?MODULE_STRING ++ " ping_me_back " ++ atom_to_list(node()) ++ "\"", - ?line io:format("~p\n", [Cmd]), + io:format("~p\n", [Cmd]), - ?line net_kernel:monitor_nodes(true), - ?line open_port({spawn,Cmd}, []), - ?line [_,Host] = string:tokens(atom_to_list(node()), "@"), - ?line Node = list_to_atom(NodeName++"@"++Host), + net_kernel:monitor_nodes(true), + open_port({spawn,Cmd}, []), + [_,Host] = string:tokens(atom_to_list(node()), "@"), + Node = list_to_atom(NodeName++"@"++Host), receive {nodeup,Node} -> - ?line io:format("Up: ~p\n", [Node]); + io:format("Up: ~p\n", [Node]); Other -> - ?line io:format("Unexpected: ~p\n", [Other]), - ?line ?t:fail() + ct:fail("Unexpected: ~p\n", [Other]) after 10000 -> - ?line ?t:fail() + ct:fail(timeout) end, - {Node,Pipe}. diff --git a/erts/test/upgrade_SUITE.erl b/erts/test/upgrade_SUITE.erl index 83cd2359d8..1d5be8f018 100644 --- a/erts/test/upgrade_SUITE.erl +++ b/erts/test/upgrade_SUITE.erl @@ -50,12 +50,12 @@ init_per_suite(Config) -> %% Fake release, no applications {skip, "Need a real release running to create other releases"}; _ -> - rm_rf(filename:join([?config(data_dir,Config),priv_dir])), + rm_rf(filename:join([proplists:get_value(data_dir,Config),priv_dir])), Config end. init_per_testcase(Case,Config) -> - PrivDir = filename:join([?config(data_dir,Config),priv_dir,Case]), + PrivDir = filename:join([proplists:get_value(data_dir,Config),priv_dir,Case]), CreateDir = filename:join([PrivDir,create]), InstallDir = filename:join([PrivDir,install]), ok = filelib:ensure_dir(filename:join(CreateDir,"*")), @@ -66,10 +66,10 @@ init_per_testcase(Case,Config) -> end_per_testcase(_Case,Config) -> Nodes = nodes(), [test_server:stop_node(Node) || Node <- Nodes], - case ?config(tc_status,Config) of + case proplists:get_value(tc_status,Config) of ok -> %% Note that priv_dir here is per test case! - rm_rf(?config(priv_dir,Config)); + rm_rf(proplists:get_value(priv_dir,Config)); _fail -> %% Test case data can be found under DataDir/priv_dir/Case ok @@ -115,15 +115,15 @@ upgrade_test(FromVsn,ToVsn,Config) -> case OldRel of false -> %% Note that priv_dir here is per test case! - rm_rf(?config(priv_dir,Config)), + rm_rf(proplists:get_value(priv_dir,Config)), {skip, "no previous release available"}; _ -> upgrade_test1(FromVsn,ToVsn,[{old_rel,OldRel}|Config]) end. upgrade_test1(FromVsn,ToVsn,Config) -> - CreateDir = ?config(create_dir,Config), - InstallDir = ?config(install_dir,Config), + CreateDir = proplists:get_value(create_dir,Config), + InstallDir = proplists:get_value(install_dir,Config), FromRelName = "otp-"++FromVsn, ToRelName = "otp-"++ToVsn, @@ -141,7 +141,7 @@ upgrade_test1(FromVsn,ToVsn,Config) -> %%% - chmod 'start' and 'start_erl' target_system(RelName0,RelVsn,CreateDir,InstallDir,Config) -> {ok,Node} = test_server:start_node(list_to_atom(RelName0),peer, - [{erl,[?config(old_rel,Config)]}]), + [{erl,[proplists:get_value(old_rel,Config)]}]), {RelName,Apps,ErtsVsn} = create_relfile(Node,CreateDir,RelName0,RelVsn), @@ -184,7 +184,7 @@ target_system(RelName0,RelVsn,CreateDir,InstallDir,Config) -> write_file(SysConfig, "[]."), %% Insert 'start' script from data_dir - modified to add sname and heart - copy_file(filename:join(?config(data_dir,Config),"start.src"), + copy_file(filename:join(proplists:get_value(data_dir,Config),"start.src"), filename:join(ErtsBinDir,"start.src")), ok = file:change_mode(filename:join(ErtsBinDir,"start.src"),8#0755), diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl index 7f3260e4cb..de3e1c24a4 100644 --- a/erts/test/z_SUITE.erl +++ b/erts/test/z_SUITE.erl @@ -24,8 +24,6 @@ %% This suite expects to be run as the last suite of all suites. %% -%-define(line_trace, 1). - -include_lib("kernel/include/file.hrl"). -record(core_search_conf, {search_dir, @@ -34,52 +32,19 @@ file, run_by_ts}). --define(DEFAULT_TIMEOUT, ?t:minutes(5)). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0]). -export([search_for_core_files/1, core_files/1]). -include_lib("common_test/include/ct.hrl"). - -init_per_testcase(Case, Config) -> - Dog = ?t:timetrap(?DEFAULT_TIMEOUT), - [{testcase, Case}, {watchdog, Dog} |Config]. - -end_per_testcase(_Case, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - ok. - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 5}}]. all() -> [core_files]. -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - - -core_files(doc) -> - []; -core_files(suite) -> - []; core_files(Config) when is_list(Config) -> case os:type() of {win32, _} -> @@ -354,7 +319,7 @@ core_file_search(#core_search_conf{search_dir = Base, case {RunByTS, ICores, FCores} of {true, [], []} -> ok; {true, _, []} -> {comment, Res}; - {true, _, _} -> ?t:fail(Res); + {true, _, _} -> ct:fail(Res); _ -> Res end end. |