diff options
81 files changed, 3395 insertions, 1942 deletions
diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml index 44c9a5ac68..588508aae6 100644 --- a/erts/doc/src/escript.xml +++ b/erts/doc/src/escript.xml @@ -153,7 +153,10 @@ halt(1).</pre> <p>Execution of interpreted code is slower than compiled code. If much of the execution takes place in interpreted code it may be worthwhile to compile it, even though the compilation - itself will take a little while.</p> + itself will take a little while. It is also possible to supply + <c>native</c> instead of compile, this will compile the script + using the native flag, again depending on the characteristics + of the escript this could or could not be worth while.</p> <p>As mentioned earlier, it is possible to have a script which contains precompiled <c>beam</c> code. In a precompiled @@ -397,6 +400,9 @@ ok Warnings and errors (if any) are written to the standard output, but the script will not be run. The exit status will be 0 if there were no errors, and 127 otherwise.</item> + + <tag>-n</tag> + <item>Compile the escript using the +native flag.</item> </taglist> </section> </comref> diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 16741aa2d7..af7ed064d3 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -321,6 +321,7 @@ extern int count_instructions; # define POST_BIF_GC_SWAPIN_0(_p, _res) \ ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ PROCESS_MAIN_CHK_LOCKS((_p)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ E = (_p)->stop; \ @@ -328,6 +329,7 @@ extern int count_instructions; HTOP = HEAP_TOP((_p)) # define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC((_p)); \ ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ PROCESS_MAIN_CHK_LOCKS((_p)); \ if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ @@ -367,6 +369,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -420,6 +423,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -442,6 +446,7 @@ extern int count_instructions; reg[0] = r(0); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ r(0) = reg[0]; \ SWAPIN; \ @@ -464,6 +469,7 @@ extern int count_instructions; reg[Live] = Extra; \ PROCESS_MAIN_CHK_LOCKS(c_p); \ FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); \ PROCESS_MAIN_CHK_LOCKS(c_p); \ if (Live > 0) { \ r(0) = reg[0]; \ @@ -1214,7 +1220,9 @@ void process_main(void) do_schedule1: PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); c_p = schedule(c_p, reds_used); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); #ifdef DEBUG pid = c_p->id; #endif @@ -1664,6 +1672,7 @@ void process_main(void) SWAPOUT; PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; } @@ -1782,6 +1791,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); }, { + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -1840,6 +1850,7 @@ void process_main(void) CANCEL_TIMER(c_p); free_message(msgp); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); NextPF(0, next); @@ -2230,6 +2241,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, arg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -2258,6 +2270,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, arg); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -2287,6 +2300,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2322,6 +2336,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2360,6 +2375,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); result = (*bf)(c_p, reg, live); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); SWAPIN; @@ -2394,6 +2410,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, tmp_arg1, tmp_arg2); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); FCALLS = c_p->fcalls; @@ -2417,6 +2434,7 @@ void process_main(void) ASSERT(!ERTS_PROC_IS_EXITING(c_p)); result = (*bf)(c_p, tmp_arg1, tmp_arg2); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ERTS_HOLE_CHECK(c_p); if (is_value(result)) { @@ -3287,6 +3305,7 @@ void process_main(void) PROCESS_MAIN_CHK_LOCKS(c_p); bif_nif_arity = I[-1]; ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); { @@ -3300,6 +3319,7 @@ void process_main(void) } ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); goto apply_bif_or_nif_epilogue; OpCase(apply_bif): @@ -3326,6 +3346,7 @@ void process_main(void) bif_nif_arity = I[-1]; ASSERT(bif_nif_arity <= 3); ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); switch (bif_nif_arity) { case 3: { @@ -3334,6 +3355,7 @@ void process_main(void) nif_bif_result = (*bf)(c_p, r(0), x(1), x(2), I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); } break; @@ -3344,6 +3366,7 @@ void process_main(void) nif_bif_result = (*bf)(c_p, r(0), x(1), I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); } break; @@ -3354,6 +3377,7 @@ void process_main(void) nif_bif_result = (*bf)(c_p, r(0), I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); } break; @@ -3364,6 +3388,7 @@ void process_main(void) nif_bif_result = (*bf)(c_p, I); ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(nif_bif_result)); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); break; } @@ -3424,7 +3449,6 @@ void process_main(void) OpCase(case_end_r): case_end_val = r(0); - I--; do_case_end: c_p->fvalue = case_end_val; @@ -4591,6 +4615,7 @@ void process_main(void) ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); flags = erts_call_trace(c_p, ep->code, ep->match_prog_set, reg, 0, &c_p->tracer_proc); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -4602,6 +4627,7 @@ void process_main(void) /* SWAPOUT, SWAPIN was done and r(0) was saved above */ PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 3, reg, ep->code[2]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -4691,6 +4717,7 @@ void process_main(void) reg[0] = r(0); PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, 2, reg, I[-1]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; } @@ -4794,6 +4821,7 @@ void process_main(void) /* SWAPOUT was done and r(0) was saved above */ PROCESS_MAIN_CHK_LOCKS(c_p); FCALLS -= erts_garbage_collect(c_p, need, reg, I[-1]); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); r(0) = reg[0]; SWAPIN; @@ -5865,9 +5893,6 @@ build_stacktrace(Process* c_p, Eterm exc) { Eterm args; int depth; BeamInstr* current; -#if HALFWORD_HEAP - BeamInstr current_buff[3]; -#endif Eterm Where = NIL; Eterm *next_p = &Where; @@ -5897,14 +5922,7 @@ build_stacktrace(Process* c_p, Eterm exc) { * (e.g. spawn_link(erlang, abs, [1])). */ if (current == NULL) { -#if HALFWORD_HEAP - current = current_buff; - current[0] = (BeamInstr) c_p->initial[0]; - current[1] = (BeamInstr) c_p->initial[1]; - current[2] = (BeamInstr) c_p->initial[2]; -#else current = c_p->initial; -#endif args = am_true; /* Just in case */ } else { args = get_args_from_exc(exc); @@ -6250,6 +6268,7 @@ hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) c_p->fvalue = NIL; PROCESS_MAIN_CHK_LOCKS(c_p); erts_garbage_collect_hibernate(c_p); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(c_p); PROCESS_MAIN_CHK_LOCKS(c_p); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); @@ -6495,6 +6514,7 @@ new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) if (HEAP_LIMIT(p) - HEAP_TOP(p) <= needed) { PROCESS_MAIN_CHK_LOCKS(p); erts_garbage_collect(p, needed, reg, num_free); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(p); PROCESS_MAIN_CHK_LOCKS(p); } hp = p->htop; diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 4e0d19dafa..788cb4209c 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -3770,25 +3770,32 @@ freeze_code(LoaderState* stp) CHKBLK(ERTS_ALC_T_CODE,code); if (compile_size) { byte* compile_info = str_table + strtab_size + attr_size; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); sys_memcpy(compile_info, stp->chunks[COMPILE_CHUNK].start, stp->chunks[COMPILE_CHUNK].size); - CHKBLK(ERTS_ALC_T_CODE,code); + + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_PTR] = (BeamInstr) compile_info; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size; - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); decoded_size = erts_decode_ext_size(compile_info, compile_size, 0); - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); if (decoded_size < 0) { LoadError0(stp, "bad external term representation of compilation information"); } - CHKBLK(ERTS_ALC_T_CODE,code); + CHKBLK(ERTS_ALC_T_CODE,code); code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; } CHKBLK(ERTS_ALC_T_CODE,code); /* + * Make sure that we have not overflowed the allocated code space. + */ + ASSERT(str_table + strtab_size + attr_size + compile_size == + ((byte *) code) + size); + + /* * Go through all i_new_bs_put_strings instructions, restore the pointer to * the instruction and convert string offsets to pointers (to the * FIRST character). diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index e85e2d7e3f..323c422c6d 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1411,6 +1411,33 @@ void erts_alloc_reg_scheduler_id(Uint id) erts_tsd_set(thr_ix_key, (void *)(long) ix); } +static void +no_verify(Allctr_t *allctr) +{ + +} + +erts_alloc_verify_func_t +erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr) +{ + if (erts_allctrs_info[ERTS_ALC_A_TEMPORARY].alloc_util + && erts_allctrs_info[ERTS_ALC_A_TEMPORARY].thr_spec) { + ErtsAllocatorThrSpec_t *tspec; + tspec = &erts_allctr_thr_spec[ERTS_ALC_A_TEMPORARY]; + if (!tspec->all_thr_safe) { + int ix = erts_alc_get_thr_ix(); + + if (ix < tspec->size) { + *allctr = tspec->allctr[ix]; + return erts_alcu_verify_unused; + } + } + } + + *allctr = NULL; + return no_verify; +} + __decl_noreturn void erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) { diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h index 3e96c76dbf..dd4cc22171 100644 --- a/erts/emulator/beam/erl_alloc.h +++ b/erts/emulator/beam/erl_alloc.h @@ -236,6 +236,11 @@ void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) #endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ +typedef void (*erts_alloc_verify_func_t)(Allctr_t *); + +erts_alloc_verify_func_t +erts_alloc_get_verify_unused_temp_alloc(Allctr_t **allctr); + #ifndef ERTS_CACHE_LINE_SIZE /* Assume a cache line size of 64 bytes */ # define ERTS_CACHE_LINE_SIZE ((UWord) 64) diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 8b184899c9..c09f0bbd77 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -3368,6 +3368,38 @@ erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) * Debug functions * \* */ +void +erts_alcu_verify_unused(Allctr_t *allctr) +{ + UWord no; + + no = allctr->sbcs.curr_mseg.no; + no += allctr->sbcs.curr_sys_alloc.no; + no += allctr->mbcs.blocks.curr.no; + + if (no) { + UWord sz = allctr->sbcs.blocks.curr.size; + sz += allctr->mbcs.blocks.curr.size; + erl_exit(ERTS_ABORT_EXIT, + "%salloc() used when expected to be unused!\n" + "Total amount of blocks allocated: %bpu\n" + "Total amount of bytes allocated: %bpu\n", + allctr->name_prefix, no, sz); + } +} + +void +erts_alcu_verify_unused_ts(Allctr_t *allctr) +{ +#ifdef USE_THREADS + erts_mtx_lock(&allctr->mutex); +#endif + erts_alcu_verify_unused(allctr); +#ifdef USE_THREADS + erts_mtx_unlock(&allctr->mutex); +#endif +} + #ifdef ERTS_ALLOC_UTIL_HARD_DEBUG static void diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h index f2b951bca6..5a8db5e29e 100644 --- a/erts/emulator/beam/erl_alloc_util.h +++ b/erts/emulator/beam/erl_alloc_util.h @@ -333,6 +333,9 @@ struct Allctr_t_ { int erts_alcu_start(Allctr_t *, AllctrInit_t *); void erts_alcu_stop(Allctr_t *); +void erts_alcu_verify_unused(Allctr_t *); +void erts_alcu_verify_unused_ts(Allctr_t *allctr); + unsigned long erts_alcu_test(unsigned long, unsigned long, unsigned long); diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c index 3508e8e0dc..db771bd216 100644 --- a/erts/emulator/beam/erl_bif_timer.c +++ b/erts/emulator/beam/erl_bif_timer.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2010. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -613,7 +613,8 @@ erts_print_bif_timer_info(int to, void *to_arg) : btm->receiver.proc.ess->id); erts_print(to, to_arg, "=timer:%T\n", receiver); erts_print(to, to_arg, "Message: %T\n", btm->message); - erts_print(to, to_arg, "Time left: %d ms\n", erts_time_left(&btm->tm)); + erts_print(to, to_arg, "Time left: %u ms\n", + erts_time_left(&btm->tm)); } } diff --git a/erts/emulator/beam/erl_cpu_topology.c b/erts/emulator/beam/erl_cpu_topology.c index 8a6b4d8d6c..bcf8bcf270 100644 --- a/erts/emulator/beam/erl_cpu_topology.c +++ b/erts/emulator/beam/erl_cpu_topology.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010. All Rights Reserved. + * Copyright Ericsson AB 2010-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -630,13 +630,13 @@ write_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) int erts_init_scheduler_bind_type_string(char *how) { - if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) + if (sys_strcmp(how, "u") == 0) + cpu_bind_order = ERTS_CPU_BIND_NONE; + else if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) return ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED; - - if (!system_cpudata && !user_cpudata) + else if (!system_cpudata && !user_cpudata) return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY; - - if (sys_strcmp(how, "db") == 0) + else if (sys_strcmp(how, "db") == 0) cpu_bind_order = ERTS_CPU_BIND_DEFAULT_BIND; else if (sys_strcmp(how, "s") == 0) cpu_bind_order = ERTS_CPU_BIND_SPREAD; @@ -652,11 +652,8 @@ erts_init_scheduler_bind_type_string(char *how) cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; else if (sys_strcmp(how, "ns") == 0) cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; - else if (sys_strcmp(how, "u") == 0) - cpu_bind_order = ERTS_CPU_BIND_NONE; else return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE; - return ERTS_INIT_SCHED_BIND_TYPE_SUCCESS; } @@ -724,6 +721,11 @@ erts_bind_schedulers(Process *c_p, Eterm how) erts_smp_rwmtx_rwlock(&cpuinfo_rwmtx); if (erts_bind_to_cpu(cpuinfo, -1) == -ENOTSUP) { + if (cpu_bind_order == ERTS_CPU_BIND_NONE + && ERTS_IS_ATOM_STR("unbound", how)) { + res = bound_schedulers_term(ERTS_CPU_BIND_NONE); + goto done; + } ERTS_BIF_PREP_ERROR(res, c_p, EXC_NOTSUP); } else { diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 484a096249..6cdbec3213 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -335,7 +335,6 @@ static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, int forward); -static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t); static int partly_bound_can_match_lesser(Eterm partly_bound_1, Eterm partly_bound_2); @@ -1747,7 +1746,6 @@ static void db_print_tree(int to, void *to_arg, "------------------------------------------------\n"); #else erts_print(to, to_arg, "Ordered set (AVL tree), Elements: %d\n", NITEMS(tb)); - do_dump_tree(to, to_arg, tb->root); #endif } @@ -2063,15 +2061,6 @@ static int analyze_pattern(DbTableTree *tb, Eterm pattern, return DB_ERROR_NONE; } -static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t) -{ - if (t != NULL) { - do_dump_tree(to, to_arg, t->left); - erts_print(to, to_arg, "%T\n", make_tuple(t->dbterm.tpl)); - do_dump_tree(to, to_arg, t->right); - } -} - static int do_free_tree_cont(DbTableTree *tb, int num_left) { TreeDbTerm *root; diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index ddfc27a93f..e4a871fd7e 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -2752,6 +2752,15 @@ erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) /* init port tasks */ erts_port_task_init(); + +#ifndef ERTS_SMP +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + erts_scheduler_data->verify_unused_temp_alloc + = erts_alloc_get_verify_unused_temp_alloc( + &erts_scheduler_data->verify_unused_temp_alloc_data); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); +#endif +#endif } ErtsRunQueue * @@ -3711,6 +3720,13 @@ sched_thread_func(void *vesdp) } erts_smp_mtx_unlock(&schdlr_sspnd.mtx); +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + ((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc + = erts_alloc_get_verify_unused_temp_alloc( + &((ErtsSchedulerData *) vesdp)->verify_unused_temp_alloc_data); + ERTS_VERIFY_UNUSED_TEMP_ALLOC(NULL); +#endif + process_main(); /* No schedulers should *ever* terminate */ erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n", diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 8479e56710..e871a9834a 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -28,6 +28,12 @@ #define ERTS_INCLUDE_SCHEDULER_INTERNALS #endif +/* #define ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC */ + +#if !defined(ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC) && defined(DEBUG) +# define ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC +#endif + typedef struct process Process; #include "sys.h" @@ -421,6 +427,11 @@ struct ErtsSchedulerData_ { /* NOTE: These fields are modified under held mutexes by other threads */ erts_smp_atomic32_t chk_cpu_bind; /* Only used when common run queue */ #endif + +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC + erts_alloc_verify_func_t verify_unused_temp_alloc; + Allctr_t *verify_unused_temp_alloc_data; +#endif }; typedef union { @@ -1145,6 +1156,20 @@ Uint erts_debug_nbalance(void); # define ERTS_PROC_GET_SCHDATA(PROC) (erts_scheduler_data) #endif +#ifdef ERTS_DO_VERIFY_UNUSED_TEMP_ALLOC +# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(P) \ +do { \ + ErtsSchedulerData *esdp__ = ((P) \ + ? ERTS_PROC_GET_SCHDATA((Process *) (P)) \ + : erts_get_scheduler_data()); \ + if (esdp__) \ + esdp__->verify_unused_temp_alloc( \ + esdp__->verify_unused_temp_alloc_data); \ +} while (0) +#else +# define ERTS_VERIFY_UNUSED_TEMP_ALLOC(ESDP) +#endif + #if defined(ERTS_SMP) || defined(USE_THREADS) ErtsSchedulerData *erts_get_scheduler_data(void); #else diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h index 84a20b51f2..8c9cace0c5 100644 --- a/erts/emulator/beam/erl_threads.h +++ b/erts/emulator/beam/erl_threads.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2001-2010. All Rights Reserved. + * Copyright Ericsson AB 2001-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -36,6 +36,16 @@ #include "erl_lock_count.h" #include "erl_term.h" +#if defined(__GLIBC__) && (__GLIBC__ << 16) + __GLIBC_MINOR__ < (2 << 16) + 4 +/* + * pthread_mutex_destroy() may return EBUSY when it shouldn't :( We have + * only seen this bug in glibc versions before 2.4. Note that condition + * variables, rwmutexes, spinlocks, and rwspinlocks also may be effected by + * this bug since these implementations may use mutexes internally. + */ +# define ERTS_THR_HAVE_BUSY_DESTROY_BUG +#endif + #define ERTS_THR_MEMORY_BARRIER ETHR_MEMORY_BARRIER #ifdef ERTS_ENABLE_LOCK_COUNT @@ -175,6 +185,9 @@ typedef struct { int gcc_is_buggy; } erts_rwlock_t; #endif /* #ifdef USE_THREADS */ #define ERTS_AINT_T_MAX (~(((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) +#define ERTS_AINT_T_MIN ((((erts_aint_t) 1) << (sizeof(erts_aint_t)*8-1))) +#define ERTS_AINT32_T_MAX (~(((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1))) +#define ERTS_AINT32_T_MIN ((((erts_aint32_t) 1) << (sizeof(erts_aint32_t)*8-1))) ERTS_GLB_INLINE void erts_thr_init(erts_thr_init_data_t *id); ERTS_GLB_INLINE void erts_thr_late_init(erts_thr_late_init_data_t *id); @@ -551,8 +564,16 @@ erts_mtx_destroy(erts_mtx_t *mtx) erts_lcnt_destroy_lock(&mtx->lcnt); #endif res = ethr_mutex_destroy(&mtx->mtx); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy mutex destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy mutex"); + } #endif } @@ -647,8 +668,16 @@ erts_cnd_destroy(erts_cnd_t *cnd) { #ifdef USE_THREADS int res = ethr_cond_destroy(cnd); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy cond destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy condition variable"); + } #endif } @@ -774,8 +803,16 @@ erts_rwmtx_destroy(erts_rwmtx_t *rwmtx) erts_lcnt_destroy_lock(&rwmtx->lcnt); #endif res = ethr_rwmutex_destroy(&rwmtx->rwmtx); - if (res != 0) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy rwmutex destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy rwmutex"); + } #endif } @@ -1452,8 +1489,16 @@ erts_spinlock_destroy(erts_spinlock_t *lock) erts_lcnt_destroy_lock(&lock->lcnt); #endif res = ethr_spinlock_destroy(&lock->slck); - if (res) - erts_thr_fatal_error(res, "destroy spinlock"); + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy spinlock destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif + erts_thr_fatal_error(res, "destroy rwlock"); + } #else (void)lock; #endif @@ -1562,8 +1607,16 @@ erts_rwlock_destroy(erts_rwlock_t *lock) erts_lcnt_destroy_lock(&lock->lcnt); #endif res = ethr_rwlock_destroy(&lock->rwlck); - if (res) + if (res != 0) { +#ifdef ERTS_THR_HAVE_BUSY_DESTROY_BUG + if (res == EBUSY) { + char *warn = "Ignoring busy rwlock destroy. " + "Most likely a bug in pthread implementation."; + erts_send_warning_to_logger_str_nogl(warn); + } +#endif erts_thr_fatal_error(res, "destroy rwlock"); + } #else (void)lock; #endif diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h index b1cd683b3b..ff828ae889 100644 --- a/erts/emulator/beam/sys.h +++ b/erts/emulator/beam/sys.h @@ -331,12 +331,16 @@ typedef unsigned char byte; (((size_t) 8) - (((size_t) (X)) & ((size_t) 7))) #include "erl_lock_check.h" + +/* needed by erl_smp.h */ +int erts_send_warning_to_logger_str_nogl(char *); + #include "erl_smp.h" #ifdef ERTS_WANT_BREAK_HANDLING # ifdef ERTS_SMP -extern erts_smp_atomic_t erts_break_requested; -# define ERTS_BREAK_REQUESTED ((int) erts_smp_atomic_read(&erts_break_requested)) +extern erts_smp_atomic32_t erts_break_requested; +# define ERTS_BREAK_REQUESTED ((int) erts_smp_atomic32_read(&erts_break_requested)) # else extern volatile int erts_break_requested; # define ERTS_BREAK_REQUESTED erts_break_requested @@ -349,8 +353,8 @@ void erts_do_break_handling(void); # define ERTS_GOT_SIGUSR1 0 # else # ifdef ERTS_SMP -extern erts_smp_atomic_t erts_got_sigusr1; -# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic_read(&erts_got_sigusr1)) +extern erts_smp_atomic32_t erts_got_sigusr1; +# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic32_read(&erts_got_sigusr1)) # else extern volatile int erts_got_sigusr1; # define ERTS_GOT_SIGUSR1 erts_got_sigusr1 @@ -517,7 +521,8 @@ int erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *); int erts_send_info_to_logger_str_nogl(char *); -int erts_send_warning_to_logger_str_nogl(char *); +/* needed by erl_smp.h (declared above) + int erts_send_warning_to_logger_str_nogl(char *); */ int erts_send_error_to_logger_str_nogl(char *); typedef struct preload { diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c index 4d0ca97889..77ac2de5f6 100644 --- a/erts/emulator/sys/common/erl_poll.c +++ b/erts/emulator/sys/common/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2006-2010. All Rights Reserved. + * Copyright Ericsson AB 2006-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -124,25 +124,11 @@ erts_smp_mtx_unlock(&(PS)->mtx) #define ERTS_POLLSET_SET_POLLED_CHK(PS) \ - ((int) erts_smp_atomic_xchg(&(PS)->polled, (erts_aint_t) 1)) + ((int) erts_atomic32_xchg(&(PS)->polled, (erts_aint32_t) 1)) #define ERTS_POLLSET_UNSET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 0) + erts_atomic32_set(&(PS)->polled, (erts_aint32_t) 0) #define ERTS_POLLSET_IS_POLLED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->polled)) - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS)) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ - ((int) erts_smp_atomic_read(&(PS)->woken)) + ((int) erts_atomic32_read(&(PS)->polled)) #else @@ -152,69 +138,21 @@ do { \ #define ERTS_POLLSET_UNSET_POLLED(PS) #define ERTS_POLLSET_IS_POLLED(PS) 0 -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - -/* - * Ideally, the ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) operation would - * be atomic. This operation isn't, but we will do okay anyway. The - * "woken check" is only an optimization. The only requirement we have: - * If (PS)->woken is set to a value != 0 when interrupting, we have to - * write on the the wakeup pipe at least once. Multiple writes are okay. - */ -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) ((PS)->woken++) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) ((PS)->woken = 1, (void) 0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) ((PS)->woken = 0, (void) 0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) ((PS)->woken) - -#else - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 - -#endif - #endif #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE #define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) \ - erts_smp_atomic_set(&(PS)->have_update_requests, (erts_aint_t) 1) + erts_smp_atomic32_set(&(PS)->have_update_requests, (erts_aint32_t) 1) #define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) \ - erts_smp_atomic_set(&(PS)->have_update_requests, (erts_aint_t) 0) + erts_smp_atomic32_set(&(PS)->have_update_requests, (erts_aint32_t) 0) #define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) \ - ((int) erts_smp_atomic_read(&(PS)->have_update_requests)) + ((int) erts_smp_atomic32_read(&(PS)->have_update_requests)) #else #define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) #define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) #define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) 0 #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) ((PS)->interrupt = 0, (void) 0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) ((PS)->interrupt = 1, (void) 0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) ((PS)->interrupt) - -#else - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->interrupt)) - -#endif - #if ERTS_POLL_USE_FALLBACK # if ERTS_POLL_USE_POLL # define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_poll_fds > 1) @@ -318,14 +256,12 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE ErtsPollSetUpdateRequestsBlock update_requests; ErtsPollSetUpdateRequestsBlock *curr_upd_req_block; - erts_smp_atomic_t have_update_requests; + erts_smp_atomic32_t have_update_requests; #endif #ifdef ERTS_SMP - erts_smp_atomic_t polled; - erts_smp_atomic_t woken; + erts_atomic32_t polled; erts_smp_mtx_t mtx; #elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - volatile int woken; #endif #if ERTS_POLL_USE_WAKEUP_PIPE int wake_fds[2]; @@ -333,12 +269,12 @@ struct ErtsPollSet_ { #if ERTS_POLL_USE_FALLBACK int fallback_used; #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - volatile int interrupt; -#else - erts_smp_atomic_t interrupt; +#ifdef ERTS_SMP + erts_atomic32_t wakeup_state; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + volatile int wakeup_state; #endif - erts_smp_atomic_t timeout; + erts_smp_atomic32_t timeout; #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_t no_avoided_wakeups; erts_smp_atomic_t no_avoided_interrupts; @@ -346,34 +282,6 @@ struct ErtsPollSet_ { #endif }; -static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) -{ - int res; -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - /* This operation isn't atomic, but we have no need at all for an - atomic operation here... */ - res = ps->interrupt; - ps->interrupt = 0; -#else - res = (int) erts_smp_atomic_xchg(&ps->interrupt, (erts_aint_t) 0); - ERTS_THR_MEMORY_BARRIER; -#endif - return res; - -} - -#ifdef ERTS_SMP - -static ERTS_INLINE int -set_poller_woken_chk(ErtsPollSet ps) -{ - ERTS_THR_MEMORY_BARRIER; - return (int) erts_smp_atomic_xchg(&ps->woken, (erts_aint_t) 1); -} - -#endif - void erts_silence_warn_unused_result(long unused); static void fatal_error(char *format, ...); static void fatal_error_async_signal_safe(char *error_str); @@ -430,6 +338,63 @@ static void check_poll_status(ErtsPollSet ps); static void print_misc_debug_info(void); #endif +#define ERTS_POLL_NOT_WOKEN 0 +#define ERTS_POLL_WOKEN -1 +#define ERTS_POLL_WOKEN_INTR 1 + +static ERTS_INLINE void +reset_wakeup_state(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + ps->wakeup_state = 0; +#endif +} + +static ERTS_INLINE int +is_woken(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + return erts_atomic32_read_acqb(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + return ps->wakeup_state != ERTS_POLL_NOT_WOKEN; +#else + return 0; +#endif +} + +static ERTS_INLINE int +is_interrupted_reset(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + return (erts_atomic32_xchg(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN) + == ERTS_POLL_WOKEN_INTR); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + int res = ps->wakeup_state == ERTS_POLL_WOKEN_INTR; + ps->wakeup_state = ERTS_POLL_NOT_WOKEN; + return res; +#else + return 0; +#endif +} + +static ERTS_INLINE void +woke_up(ErtsPollSet ps) +{ +#ifdef ERTS_SMP + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + if (wakeup_state == ERTS_POLL_NOT_WOKEN) + (void) erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN, + ERTS_POLL_NOT_WOKEN); + ASSERT(erts_atomic32_read(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + if (ps->wakeup_state == ERTS_POLL_NOT_WOKEN) + ps->wakeup_state = ERTS_POLL_WOKEN; +#endif +} + /* * --- Wakeup pipe ----------------------------------------------------------- */ @@ -437,14 +402,34 @@ static void print_misc_debug_info(void); #if ERTS_POLL_USE_WAKEUP_PIPE static ERTS_INLINE void -wake_poller(ErtsPollSet ps) +wake_poller(ErtsPollSet ps, int interrupted) { + int wake; +#ifdef ERTS_SMP + erts_aint32_t wakeup_state; + if (!interrupted) + wakeup_state = erts_atomic32_cmpxchg_relb(&ps->wakeup_state, + ERTS_POLL_WOKEN, + ERTS_POLL_NOT_WOKEN); + else { + /* + * We might unnecessarily write to the pipe, however, + * that isn't problematic. + */ + wakeup_state = erts_atomic32_read(&ps->wakeup_state); + erts_atomic32_set_relb(&ps->wakeup_state, ERTS_POLL_WOKEN_INTR); + } + wake = wakeup_state == ERTS_POLL_NOT_WOKEN; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + wake = ps->wakeup_state == ERTS_POLL_NOT_WOKEN; + ps->wakeup_state = interrupted ? ERTS_POLL_WOKEN_INTR : ERTS_POLL_NOT_WOKEN; +#endif /* * NOTE: This function might be called from signal handlers in the * non-smp case; therefore, it has to be async-signal safe in * the non-smp case. */ - if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + if (wake) { ssize_t res; if (ps->wake_fds[1] < 0) return; /* Not initialized yet */ @@ -1387,9 +1372,7 @@ handle_update_requests(ErtsPollSet ps) #endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ static ERTS_INLINE ErtsPollEvents -poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, - int *have_set_have_update_requests, - int *do_wake) +poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, int *do_wake) { ErtsPollEvents new_events; @@ -1493,7 +1476,6 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, int len) { int i; - int hshur = 0; int do_wake; int final_do_wake = 0; @@ -1505,17 +1487,17 @@ ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, pcev[i].fd, pcev[i].events, pcev[i].on, - &hshur, &do_wake); final_do_wake |= do_wake; } + ERTS_POLLSET_UNLOCK(ps); + #ifdef ERTS_SMP if (final_do_wake) - wake_poller(ps); + wake_poller(ps, 0); #endif /* ERTS_SMP */ - ERTS_POLLSET_UNLOCK(ps); } ErtsPollEvents @@ -1526,20 +1508,20 @@ ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps, int* do_wake) /* In: Wake up polling thread */ /* Out: Poller is woken */ { - int hshur = 0; ErtsPollEvents res; ERTS_POLLSET_LOCK(ps); - res = poll_control(ps, fd, events, on, &hshur, do_wake); + res = poll_control(ps, fd, events, on, do_wake); + + ERTS_POLLSET_UNLOCK(ps); #ifdef ERTS_SMP if (*do_wake) { - wake_poller(ps); + wake_poller(ps, 0); } #endif /* ERTS_SMP */ - ERTS_POLLSET_UNLOCK(ps); return res; } @@ -1918,9 +1900,11 @@ check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) return 0; } else { - erts_aint_t timeout = tv->tv_sec*1000 + tv->tv_usec/1000; + long timeout = tv->tv_sec*1000 + tv->tv_usec/1000; + if (timeout > ERTS_AINT32_T_MAX) + timeout = ERTS_AINT32_T_MAX; ASSERT(timeout >= 0); - erts_smp_atomic_set(&ps->timeout, timeout); + erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); #if ERTS_POLL_USE_FALLBACK if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) { @@ -2042,15 +2026,14 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, (int) tv->tv_sec*1000 + tv->tv_usec/1000); #endif - ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { res = EINVAL; /* Another thread is in erts_poll_wait() on this pollset... */ goto done; } - if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { - /* Interrupt use zero timeout */ + if (is_woken(ps)) { + /* Use zero timeout */ itv.tv_sec = 0; itv.tv_usec = 0; tvp = &itv; @@ -2067,7 +2050,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, ps_locked = 0; res = check_fd_events(ps, tvp, no_fds, &ps_locked); - ERTS_POLLSET_SET_POLLER_WOKEN(ps); + woke_up(ps); if (res == 0) { res = ETIMEDOUT; @@ -2099,9 +2082,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, check_poll_result(pr, no_fds); #endif - res = (no_fds == 0 - ? (ERTS_POLLSET_UNSET_INTERRUPTED_CHK(ps) ? EINTR : EAGAIN) - : 0); + res = (no_fds == 0 ? (is_interrupted_reset(ps) ? EINTR : EAGAIN) : 0); *len = no_fds; } @@ -2112,7 +2093,7 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, #endif done: - erts_smp_atomic_set(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_set_relb(&ps->timeout, ERTS_AINT32_T_MAX); #ifdef ERTS_POLL_DEBUG_PRINT erts_printf("Leaving %s = erts_poll_wait()\n", res == 0 ? "0" : erl_errno_id(res)); @@ -2128,20 +2109,17 @@ ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set) { +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) /* * NOTE: This function might be called from signal handlers in the * non-smp case; therefore, it has to be async-signal safe in * the non-smp case. */ - if (set) { - ERTS_POLLSET_SET_INTERRUPTED(ps); -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) - wake_poller(ps); + if (!set) + reset_wakeup_state(ps); + else + wake_poller(ps, 1); #endif - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } } /* @@ -2154,13 +2132,12 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, int set, long msec) { - if (set) { - if (erts_smp_atomic_read(&ps->timeout) > (erts_aint_t) msec) { - ERTS_POLLSET_SET_INTERRUPTED(ps); #if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) - wake_poller(ps); -#endif - } + if (!set) + reset_wakeup_state(ps); + else { + if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + wake_poller(ps, 1); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS else { if (ERTS_POLLSET_IS_POLLED(ps)) @@ -2170,9 +2147,7 @@ ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, erts_smp_atomic_inc(&ps->no_interrupt_timed); #endif } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } +#endif } int @@ -2283,14 +2258,16 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) ps->update_requests.next = NULL; ps->update_requests.len = 0; ps->curr_upd_req_block = &ps->update_requests; - erts_smp_atomic_init(&ps->have_update_requests, 0); + erts_smp_atomic32_init(&ps->have_update_requests, 0); #endif #ifdef ERTS_SMP - erts_smp_atomic_init(&ps->polled, 0); - erts_smp_atomic_init(&ps->woken, 0); + erts_atomic32_init(&ps->polled, 0); erts_smp_mtx_init(&ps->mtx, "pollset"); +#endif +#ifdef ERTS_SMP + erts_atomic32_init(&ps->wakeup_state, (erts_aint32_t) 0); #elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT - ps->woken = 0; + ps->wakeup_state = 0; #endif #if ERTS_POLL_USE_WAKEUP_PIPE create_wakeup_pipe(ps); @@ -2312,12 +2289,7 @@ ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) ps->internal_fd_limit = kp_fd + 1; ps->kp_fd = kp_fd; #endif -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) - ps->interrupt = 0; -#else - erts_smp_atomic_init(&ps->interrupt, 0); -#endif - erts_smp_atomic_init(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_init(&ps->timeout, ERTS_AINT32_T_MAX); #ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS erts_smp_atomic_init(&ps->no_avoided_wakeups, 0); erts_smp_atomic_init(&ps->no_avoided_interrupts, 0); diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index bfc04faa45..bc940d2084 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -160,14 +160,14 @@ static int debug_log = 0; #endif #ifdef ERTS_SMP -erts_smp_atomic_t erts_got_sigusr1; +erts_smp_atomic32_t erts_got_sigusr1; #define ERTS_SET_GOT_SIGUSR1 \ - erts_smp_atomic_set(&erts_got_sigusr1, 1) + erts_smp_atomic32_set(&erts_got_sigusr1, 1) #define ERTS_UNSET_GOT_SIGUSR1 \ - erts_smp_atomic_set(&erts_got_sigusr1, 0) -static erts_smp_atomic_t have_prepared_crash_dump; + erts_smp_atomic32_set(&erts_got_sigusr1, 0) +static erts_smp_atomic32_t have_prepared_crash_dump; #define ERTS_PREPARED_CRASH_DUMP \ - ((int) erts_smp_atomic_xchg(&have_prepared_crash_dump, 1)) + ((int) erts_smp_atomic32_xchg(&have_prepared_crash_dump, 1)) #else volatile int erts_got_sigusr1; #define ERTS_SET_GOT_SIGUSR1 (erts_got_sigusr1 = 1) @@ -235,11 +235,11 @@ static int max_files = -1; * a few variables used by the break handler */ #ifdef ERTS_SMP -erts_smp_atomic_t erts_break_requested; +erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else volatile int erts_break_requested = 0; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) @@ -504,9 +504,9 @@ erts_sys_pre_init(void) #endif } #ifdef ERTS_SMP - erts_smp_atomic_init(&erts_break_requested, 0); - erts_smp_atomic_init(&erts_got_sigusr1, 0); - erts_smp_atomic_init(&have_prepared_crash_dump, 0); + erts_smp_atomic32_init(&erts_break_requested, 0); + erts_smp_atomic32_init(&erts_got_sigusr1, 0); + erts_smp_atomic32_init(&have_prepared_crash_dump, 0); #else erts_break_requested = 0; erts_got_sigusr1 = 0; diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c index d84ae2ede2..1f2877b682 100644 --- a/erts/emulator/sys/win32/erl_poll.c +++ b/erts/emulator/sys/win32/erl_poll.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2007-2010. All Rights Reserved. + * Copyright Ericsson AB 2007-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -274,7 +274,6 @@ struct ErtsPollSet_ { Waiter** waiter; int allocated_waiters; /* Size ow waiter array */ int num_waiters; /* Number of waiter threads. */ - erts_atomic_t sys_io_ready; /* Tells us there is I/O ready (already). */ int restore_events; /* Tells us to restore waiters events next time around */ HANDLE event_io_ready; /* To be used when waiting for io */ @@ -282,12 +281,11 @@ struct ErtsPollSet_ { volatile int standby_wait_counter; /* Number of threads to wait for */ CRITICAL_SECTION standby_crit; /* CS to guard the counter */ HANDLE standby_wait_event; /* Event signalled when counte == 0 */ + erts_atomic32_t wakeup_state; #ifdef ERTS_SMP - erts_smp_atomic_t woken; erts_smp_mtx_t mtx; - erts_smp_atomic_t interrupt; #endif - erts_smp_atomic_t timeout; + erts_smp_atomic32_t timeout; }; #ifdef ERTS_SMP @@ -296,126 +294,24 @@ struct ErtsPollSet_ { erts_smp_mtx_lock(&(PS)->mtx) #define ERTS_POLLSET_UNLOCK(PS) \ erts_smp_mtx_unlock(&(PS)->mtx) -#define ERTS_POLLSET_SET_POLLED_CHK(PS) \ - ((int) erts_smp_atomic_xchg(&(PS)->polled, (erts_aint_t) 1)) -#define ERTS_POLLSET_SET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 1) -#define ERTS_POLLSET_UNSET_POLLED(PS) \ - erts_smp_atomic_set(&(PS)->polled, (erts_aint_t) 0) -#define ERTS_POLLSET_IS_POLLED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->polled)) - -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) set_poller_woken_chk((PS)) -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->woken, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ - ((int) erts_smp_atomic_read(&(PS)->woken)) - -#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) -#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ -do { \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 0); \ - ERTS_THR_MEMORY_BARRIER; \ -} while (0) -#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ -do { \ - ERTS_THR_MEMORY_BARRIER; \ - erts_smp_atomic_set(&(PS)->interrupt, (erts_aint_t) 1); \ -} while (0) -#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ - ((int) erts_smp_atomic_read(&(PS)->interrupt)) - -static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) -{ - int res = (int) erts_smp_atomic_xchg(&ps->interrupt, (erts_aint_t) 0); - ERTS_THR_MEMORY_BARRIER; - return res; - -} - -static ERTS_INLINE int -set_poller_woken_chk(ErtsPollSet ps) -{ - ERTS_THR_MEMORY_BARRIER; - return (int) erts_smp_atomic_xchg(&ps->woken, (erts_aint_t) 1); -} #else #define ERTS_POLLSET_LOCK(PS) #define ERTS_POLLSET_UNLOCK(PS) -#define ERTS_POLLSET_SET_POLLED_CHK(PS) 0 -#define ERTS_POLLSET_UNSET_POLLED(PS) -#define ERTS_POLLSET_IS_POLLED(PS) 0 -#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 -#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) -#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 - #endif /* - * While atomics are not yet implemented for windows in the common library... - * - * MSDN doc states that SMP machines and old compilers require - * InterLockedExchange to properly read and write interlocked - * variables, otherwise the processors might reschedule - * the access and order of atomics access is destroyed... - * While they only mention it in white-papers, the problem - * in VS2003 is due to the IA64 arch, so we can still count - * on the CPU not rescheduling the access to volatile in X86 arch using - * even the slightly older compiler... - * - * So here's (hopefully) a subset of the generally working atomic - * variable access... - */ - -#if defined(__GNUC__) -# if defined(__i386__) || defined(__x86_64__) -# define VOLATILE_IN_SEQUENCE 1 -# else -# define VOLATILE_IN_SEQUENCE 0 -# endif -#elif defined(_MSC_VER) -# if _MSC_VER < 1300 -# define VOLATILE_IN_SEQUENCE 0 /* Dont trust really old compilers */ -# else -# if defined(_M_IX86) -# define VOLATILE_IN_SEQUENCE 1 -# else /* I.e. IA64 */ -# if _MSC_VER >= 1400 -# define VOLATILE_IN_SEQUENCE 1 -# else -# define VOLATILE_IN_SEQUENCE 0 -# endif -# endif -# endif -#else -# define VOLATILE_IN_SEQUENCE 0 -#endif - - - -/* * Communication with sys_interrupt */ #ifdef ERTS_SMP -extern erts_smp_atomic_t erts_break_requested; +extern erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else extern volatile int erts_break_requested; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) @@ -424,7 +320,7 @@ extern volatile int erts_break_requested; static erts_mtx_t break_waiter_lock; static HANDLE break_happened_event; -static erts_atomic_t break_waiter_state; +static erts_atomic32_t break_waiter_state; #define BREAK_WAITER_GOT_BREAK 1 #define BREAK_WAITER_GOT_HALT 2 @@ -467,29 +363,168 @@ do { \ wait_standby(PS); \ } while(0) -#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) +#define ERTS_POLL_NOT_WOKEN ((erts_aint32_t) 0) +#define ERTS_POLL_WOKEN_IO_READY ((erts_aint32_t) 1) +#define ERTS_POLL_WOKEN_INTR ((erts_aint32_t) 2) +#define ERTS_POLL_WOKEN_TIMEDOUT ((erts_aint32_t) 3) static ERTS_INLINE int -unset_interrupted_chk(ErtsPollSet ps) +is_io_ready(ErtsPollSet ps) { - /* This operation isn't atomic, but we have no need at all for an - atomic operation here... */ - int res = ps->interrupt; - ps->interrupt = 0; - return res; + return erts_atomic32_read(&ps->wakeup_state) == ERTS_POLL_WOKEN_IO_READY; } +static ERTS_INLINE void +woke_up(ErtsPollSet ps) +{ + if (erts_atomic32_read(&ps->wakeup_state) == ERTS_POLL_NOT_WOKEN) + erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN_TIMEDOUT, + ERTS_POLL_NOT_WOKEN); +#ifdef DEBUG + { + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + switch (wakeup_state) { + case ERTS_POLL_WOKEN_IO_READY: + case ERTS_POLL_WOKEN_INTR: + case ERTS_POLL_WOKEN_TIMEDOUT: + break; + default: + ASSERT(0); + break; + } + } #endif +} + +static ERTS_INLINE int +wakeup_cause(ErtsPollSet ps) +{ + int res; + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + switch (wakeup_state) { + case ERTS_POLL_WOKEN_IO_READY: + res = 0; + break; + case ERTS_POLL_WOKEN_INTR: + res = EINTR; + break; + case ERTS_POLL_WOKEN_TIMEDOUT: + res = ETIMEDOUT; + break; + default: + res = 0; + erl_exit(ERTS_ABORT_EXIT, + "%s:%d: Internal error: Invalid wakeup_state=%d\n", + __FILE__, __LINE__, (int) wakeup_state); + } + return res; +} + +static ERTS_INLINE DWORD +poll_wait_timeout(ErtsPollSet ps, SysTimeval *tvp) +{ + time_t timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; + + if (timeout <= 0) { + woke_up(ps); + return (DWORD) 0; + } + + ResetEvent(ps->event_io_ready); + /* + * Since we don't know the internals of ResetEvent() we issue + * a memory barrier as a safety precaution ensuring that + * the load of wakeup_state wont be reordered with stores made + * by ResetEvent(). + */ + ERTS_THR_MEMORY_BARRIER; + if (erts_atomic32_read(&ps->wakeup_state) != ERTS_POLL_NOT_WOKEN) + return (DWORD) 0; + + if (timeout > ERTS_AINT32_T_MAX) /* Also prevents DWORD overflow */ + timeout = ERTS_AINT32_T_MAX; + + erts_smp_atomic32_set_relb(&ps->timeout, (erts_aint32_t) timeout); + return (DWORD) timeout; +} -#ifdef ERTS_SMP static ERTS_INLINE void -wake_poller(ErtsPollSet ps) +wake_poller(ErtsPollSet ps, int io_ready) { - if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + if (io_ready) { + /* We may set the event multiple times. This is, however, harmless. */ + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY); + } + else { + while (wakeup_state != ERTS_POLL_WOKEN_IO_READY + && wakeup_state != ERTS_POLL_WOKEN_INTR) { + erts_aint32_t act = erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_WOKEN_INTR, + wakeup_state); + if (act == wakeup_state) { + wakeup_state = act; + break; + } + wakeup_state = act; + } + } + if (wakeup_state == ERTS_POLL_NOT_WOKEN) { + /* + * Since we don't know the internals of SetEvent() we issue + * a memory barrier as a safety precaution ensuring that + * the store we just made to wakeup_state wont be reordered + * with loads in SetEvent(). + */ + ERTS_THR_MEMORY_BARRIER; SetEvent(ps->event_io_ready); } } -#endif + +static ERTS_INLINE void +reset_io_ready(ErtsPollSet ps) +{ + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); +} + +static ERTS_INLINE void +restore_io_ready(ErtsPollSet ps) +{ + erts_atomic32_set(&ps->wakeup_state, ERTS_POLL_WOKEN_IO_READY); +} + +/* + * notify_io_ready() is used by threads waiting for events, when + * notifying a poller thread about I/O ready. + */ +static ERTS_INLINE void +notify_io_ready(ErtsPollSet ps) +{ + wake_poller(ps, 1); +} + +static ERTS_INLINE void +reset_interrupt(ErtsPollSet ps) +{ + /* We need to keep io-ready if set */ + erts_aint32_t wakeup_state = erts_atomic32_read(&ps->wakeup_state); + while (wakeup_state != ERTS_POLL_WOKEN_IO_READY + && wakeup_state != ERTS_POLL_NOT_WOKEN) { + erts_aint32_t act = erts_atomic32_cmpxchg(&ps->wakeup_state, + ERTS_POLL_NOT_WOKEN, + wakeup_state); + if (wakeup_state == act) + break; + wakeup_state = act; + } +} + +static ERTS_INLINE void +set_interrupt(ErtsPollSet ps) +{ + wake_poller(ps, 0); +} static void setup_standby_wait(ErtsPollSet ps, int num_threads) { @@ -653,14 +688,14 @@ static void *break_waiter(void *param) case WAIT_OBJECT_0: ResetEvent(harr[0]); erts_mtx_lock(&break_waiter_lock); - erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_BREAK); + erts_atomic32_set(&break_waiter_state,BREAK_WAITER_GOT_BREAK); SetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); break; case (WAIT_OBJECT_0+1): ResetEvent(harr[1]); erts_mtx_lock(&break_waiter_lock); - erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_HALT); + erts_atomic32_set(&break_waiter_state,BREAK_WAITER_GOT_HALT); SetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); break; @@ -767,12 +802,7 @@ event_happened: consistency_check(w); #endif ASSERT(WAIT_OBJECT_0 < i && i < WAIT_OBJECT_0+w->active_events); - if (!erts_atomic_xchg(&ps->sys_io_ready,1)) { - HARDDEBUGF(("SET EventIoReady (%d)",erts_atomic_read(&ps->sys_io_ready))); - SetEvent(ps->event_io_ready); - } else { - HARDDEBUGF(("DONT SET EventIoReady")); - } + notify_io_ready(ps); /* * The main thread wont start working on our arrays untill we're @@ -967,15 +997,10 @@ static int cancel_driver_select(ErtsPollSet ps, HANDLE event) void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */) { HARDTRACEF(("In erts_poll_interrupt(%d)",set)); -#ifdef ERTS_SMP - if (set) { - ERTS_POLLSET_SET_INTERRUPTED(ps); - wake_poller(ps); - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } -#endif + if (!set) + reset_interrupt(ps); + else + set_interrupt(ps); HARDTRACEF(("Out erts_poll_interrupt(%d)",set)); } @@ -984,17 +1009,10 @@ void erts_poll_interrupt_timed(ErtsPollSet ps, long msec) { HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec)); -#ifdef ERTS_SMP - if (set) { - if (erts_smp_atomic_read(&ps->timeout) > (erts_aint_t) msec) { - ERTS_POLLSET_SET_INTERRUPTED(ps); - wake_poller(ps); - } - } - else { - ERTS_POLLSET_UNSET_INTERRUPTED(ps); - } -#endif + if (!set) + reset_interrupt(ps); + else if (erts_smp_atomic32_read_acqb(&ps->timeout) > (erts_aint32_t) msec) + set_interrupt(ps); HARDTRACEF(("Out erts_poll_interrupt_timed")); } @@ -1068,10 +1086,8 @@ void erts_poll_controlv(ErtsPollSet ps, int erts_poll_wait(ErtsPollSet ps, ErtsPollResFd pr[], int *len, - SysTimeval *utvp) + SysTimeval *tvp) { - SysTimeval *tvp = utvp; - SysTimeval itv; int no_fds; DWORD timeout; EventData* ev; @@ -1084,7 +1100,7 @@ int erts_poll_wait(ErtsPollSet ps, HARDTRACEF(("In erts_poll_wait")); ERTS_POLLSET_LOCK(ps); - if (!erts_atomic_read(&ps->sys_io_ready) && ps->restore_events) { + if (!is_io_ready(ps) && ps->restore_events) { HARDDEBUGF(("Restore events: %d",ps->num_waiters)); ps->restore_events = 0; for (i = 0; i < ps->num_waiters; ++i) { @@ -1102,7 +1118,7 @@ int erts_poll_wait(ErtsPollSet ps, if (w->highwater != w->active_events) { HARDDEBUGF(("Oups!")); /* Oups, got signalled before we took the lock, can't reset */ - if(erts_atomic_read(&ps->sys_io_ready) == 0) { + if(!is_io_ready(ps)) { erl_exit(1,"Internal error: " "Inconsistent io structures in erl_poll.\n"); } @@ -1127,39 +1143,27 @@ int erts_poll_wait(ErtsPollSet ps, no_fds = ERTS_POLL_MAX_RES; #endif + timeout = poll_wait_timeout(ps, tvp); - ResetEvent(ps->event_io_ready); - ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); - -#ifdef ERTS_SMP - if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { - /* Interrupt use zero timeout */ - itv.tv_sec = 0; - itv.tv_usec = 0; - tvp = &itv; - } -#endif - - timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; /*HARDDEBUGF(("timeout = %ld",(long) timeout));*/ - erts_smp_atomic_set(&ps->timeout, timeout); - if (timeout > 0 && ! erts_atomic_read(&ps->sys_io_ready) && ! erts_atomic_read(&break_waiter_state)) { + if (timeout > 0 && !erts_atomic32_read(&break_waiter_state)) { HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; int num_h = 2; - HARDDEBUGF(("Start waiting %d [%d]",num_h, (long) timeout)); + HARDDEBUGF(("Start waiting %d [%d]",num_h, (int) timeout)); ERTS_POLLSET_UNLOCK(ps); WaitForMultipleObjects(num_h, harr, FALSE, timeout); ERTS_POLLSET_LOCK(ps); - HARDDEBUGF(("Stop waiting %d [%d]",num_h, (long) timeout)); + HARDDEBUGF(("Stop waiting %d [%d]",num_h, (int) timeout)); + woke_up(ps); } ERTS_UNSET_BREAK_REQUESTED; - if(erts_atomic_read(&break_waiter_state)) { + if(erts_atomic32_read(&break_waiter_state)) { erts_mtx_lock(&break_waiter_lock); - break_state = erts_atomic_read(&break_waiter_state); - erts_atomic_set(&break_waiter_state,0); + break_state = erts_atomic32_read(&break_waiter_state); + erts_atomic32_set(&break_waiter_state,0); ResetEvent(break_happened_event); erts_mtx_unlock(&break_waiter_lock); switch (break_state) { @@ -1174,15 +1178,13 @@ int erts_poll_wait(ErtsPollSet ps, } } - ERTS_POLLSET_SET_POLLER_WOKEN(ps); - - if (!erts_atomic_read(&ps->sys_io_ready)) { - res = EINTR; - HARDDEBUGF(("EINTR!")); - goto done; + res = wakeup_cause(ps); + if (res != 0) { + HARDDEBUGF(("%s!", res == EINTR ? "EINTR" : "ETIMEDOUT")); + goto done; } - erts_atomic_set(&ps->sys_io_ready,0); + reset_io_ready(ps); n = ps->num_waiters; @@ -1204,9 +1206,9 @@ int erts_poll_wait(ErtsPollSet ps, if (num >= no_fds) { w->highwater=j+1; erts_mtx_unlock(&w->mtx); - /* This might mean we still have data to report, set - back the global flag! */ - erts_atomic_set(&ps->sys_io_ready,1); + /* This might mean we still have data to report, + restore flag indicating I/O ready! */ + restore_io_ready(ps); HARDDEBUGF(("To many FD's to report!")); goto done; } @@ -1228,7 +1230,7 @@ int erts_poll_wait(ErtsPollSet ps, erts_mtx_unlock(&w->mtx); } done: - erts_smp_atomic_set(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_set(&ps->timeout, ERTS_AINT32_T_MAX); *len = num; ERTS_POLLSET_UNLOCK(ps); HARDTRACEF(("Out erts_poll_wait")); @@ -1306,15 +1308,13 @@ ErtsPollSet erts_poll_create_pollset(void) ps->standby_wait_counter = 0; ps->event_io_ready = CreateManualEvent(FALSE); ps->standby_wait_event = CreateManualEvent(FALSE); - erts_atomic_init(&ps->sys_io_ready,0); ps->restore_events = 0; + erts_atomic32_init(&ps->wakeup_state, ERTS_POLL_NOT_WOKEN); #ifdef ERTS_SMP - erts_smp_atomic_init(&ps->woken, 0); erts_smp_mtx_init(&ps->mtx, "pollset"); - erts_smp_atomic_init(&ps->interrupt, 0); #endif - erts_smp_atomic_init(&ps->timeout, ERTS_AINT_T_MAX); + erts_smp_atomic32_init(&ps->timeout, ERTS_AINT32_T_MAX); HARDTRACEF(("Out erts_poll_create_pollset")); return ps; @@ -1366,7 +1366,7 @@ void erts_poll_init(void) erts_mtx_init(&break_waiter_lock,"break_waiter_lock"); break_happened_event = CreateManualEvent(FALSE); - erts_atomic_init(&break_waiter_state, 0); + erts_atomic32_init(&break_waiter_state, 0); erts_thr_create(&thread, &break_waiter, NULL, NULL); ERTS_UNSET_BREAK_REQUESTED; diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c index 262f84babc..943c338794 100644 --- a/erts/emulator/sys/win32/sys_interrupt.c +++ b/erts/emulator/sys/win32/sys_interrupt.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1997-2010. All Rights Reserved. + * Copyright Ericsson AB 1997-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -31,11 +31,11 @@ #endif #ifdef ERTS_SMP -erts_smp_atomic_t erts_break_requested; +erts_smp_atomic32_t erts_break_requested; #define ERTS_SET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 1) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 1) #define ERTS_UNSET_BREAK_REQUESTED \ - erts_smp_atomic_set(&erts_break_requested, (erts_aint_t) 0) + erts_smp_atomic32_set(&erts_break_requested, (erts_aint32_t) 0) #else volatile int erts_break_requested = 0; #define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index 9b8905712e..7e409f053e 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1321,11 +1321,4 @@ unaligned_sub_bin(Bin0, Offs) -> <<_:Offs,Bin:Sz/binary,_:Roffs>> = id(Bin1), Bin. -hostname() -> - from($@, atom_to_list(node())). - -from(H, [H | T]) -> T; -from(H, [_ | T]) -> from(H, T); -from(_, []) -> []. - id(I) -> I. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl index 6bddbb14f5..2b21fa58f4 100644 --- a/erts/emulator/test/match_spec_SUITE.erl +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,7 +30,7 @@ -export([runner/2]). -export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). --export([do_boxed_and_small/0, suite/0]). +-export([do_boxed_and_small/0]). % This test suite assumes that tracing in general works. What we test is % the match spec functionality. @@ -365,15 +365,15 @@ silent_no_ms(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), ?MODULE:f1(start), ?MODULE:f2(f, g), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(h, i), ?MODULE:f1(stop), ?MODULE:f2(j, k), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(l, m) end, fun (Tracee) -> @@ -413,15 +413,15 @@ silent_no_ms(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), ?MODULE:f1(start), ?MODULE:f2(f, g), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(h, i), ?MODULE:f1(stop), ?MODULE:f2(j, k), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(l, m) end, fun (Tracee) -> @@ -475,18 +475,18 @@ ms_trace2(Config) when is_list(Config) -> fun () -> ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), fn([all], [call,return_to,{tracer,Tracer}]), ?MODULE:f1(f), f2(g, h), f1(i), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(j, k), fn([call,return_to], []), ?MODULE:f1(l), ?MODULE:f2(m, n), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(o, p) end, fun (Tracee) -> @@ -571,26 +571,26 @@ ms_trace3(Config) when is_list(Config) -> register(TraceeName, self()), ?MODULE:f1(a), ?MODULE:f2(b, c), - erlang:integer_to_list(id(1)), + _ = erlang:integer_to_list(id(1)), ?MODULE:f3(d, e), Controller ! {self(),Tag,start}, receive {Controller,Tag,started} -> ok end, ?MODULE:f1(f), f2(g, h), f1(i), - erlang:integer_to_list(id(2)), + _ = erlang:integer_to_list(id(2)), ?MODULE:f3(j, k), Controller ! {self(),Tag,stop_1}, receive {Controller,Tag,stopped_1} -> ok end, ?MODULE:f1(l), ?MODULE:f2(m, n), - erlang:integer_to_list(id(3)), + _ = erlang:integer_to_list(id(3)), ?MODULE:f3(o, p), Controller ! {self(),Tag,stop_2}, receive {Controller,Tag,stopped_2} -> ok end, ?MODULE:f1(q), ?MODULE:f2(r, s), - erlang:integer_to_list(id(4)), + _ = erlang:integer_to_list(id(4)), ?MODULE:f3(t, u) end, diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl index f0668dd287..5a7cdcecd5 100644 --- a/erts/emulator/test/pseudoknot_SUITE.erl +++ b/erts/emulator/test/pseudoknot_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -3294,13 +3294,13 @@ most_distant_atom(Sols) -> maximum(map(sol_most_distant_atom, Sols)). maximum([H|T]) -> - max(T,H). + max1(T,H). -max([H|T],M) when is_float(H), is_float(M), H > M -> - max(T,H); -max([_|T],M) -> - max(T,M); -max([],M) -> M. +max1([H|T],M) when is_float(H), is_float(M), H > M -> + max1(T,H); +max1([_|T],M) -> + max1(T,M); +max1([],M) -> M. map(_Func,[]) -> []; map(Func,[H|T]) -> diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl index 1478bbeb52..f16d0ea429 100644 --- a/erts/emulator/test/scheduler_SUITE.erl +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -862,9 +862,9 @@ get_affinity_mask(Port, Status, Affinity) when Status == unknown; {Port,{exit_status,S}} -> get_affinity_mask(Port, S, Affinity) end; -get_affinity_mask(Port, Status, bad) -> +get_affinity_mask(_Port, _Status, bad) -> unknown; -get_affinity_mask(Port, Status, Affinity) -> +get_affinity_mask(_Port, _Status, Affinity) -> Affinity. get_affinity_mask() -> @@ -1389,67 +1389,6 @@ reader_groups_map(CPUT, Groups) -> %% Utils %% -tilera_cpu_topology() -> - [{processor,[{node,[{core,{logical,0}}, - {core,{logical,1}}, - {core,{logical,2}}, - {core,{logical,8}}, - {core,{logical,9}}, - {core,{logical,10}}, - {core,{logical,11}}, - {core,{logical,16}}, - {core,{logical,17}}, - {core,{logical,18}}, - {core,{logical,19}}, - {core,{logical,24}}, - {core,{logical,25}}, - {core,{logical,27}}, - {core,{logical,29}}]}, - {node,[{core,{logical,3}}, - {core,{logical,4}}, - {core,{logical,5}}, - {core,{logical,6}}, - {core,{logical,7}}, - {core,{logical,12}}, - {core,{logical,13}}, - {core,{logical,14}}, - {core,{logical,15}}, - {core,{logical,20}}, - {core,{logical,21}}, - {core,{logical,22}}, - {core,{logical,23}}, - {core,{logical,28}}, - {core,{logical,30}}]}, - {node,[{core,{logical,31}}, - {core,{logical,36}}, - {core,{logical,37}}, - {core,{logical,38}}, - {core,{logical,44}}, - {core,{logical,45}}, - {core,{logical,46}}, - {core,{logical,47}}, - {core,{logical,51}}, - {core,{logical,52}}, - {core,{logical,53}}, - {core,{logical,54}}, - {core,{logical,55}}, - {core,{logical,60}}, - {core,{logical,61}}]}, - {node,[{core,{logical,26}}, - {core,{logical,32}}, - {core,{logical,33}}, - {core,{logical,34}}, - {core,{logical,35}}, - {core,{logical,39}}, - {core,{logical,40}}, - {core,{logical,41}}, - {core,{logical,42}}, - {core,{logical,43}}, - {core,{logical,48}}, - {core,{logical,49}}, - {core,{logical,50}}, - {core,{logical,58}}]}]}]. - l(Id) -> {logical, Id}. diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl index 8bf66b7177..5dfa87bbee 100644 --- a/erts/emulator/test/trace_call_time_SUITE.erl +++ b/erts/emulator/test/trace_call_time_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010. All Rights Reserved. +%% Copyright Ericsson AB 2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -427,7 +427,7 @@ nif(Config) when is_list(Config) -> ?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]), ?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]), ?line Pid = setup(), - ?line {L, T1} = execute(Pid, fun() -> with_nif(M) end), + ?line {_, T1} = execute(Pid, fun() -> with_nif(M) end), % the nif is called M - 1 times, the last time the function with 'with_nif' % returns ok and does not call the nif. @@ -506,7 +506,7 @@ with_nif(N) -> with_nif(?MODULE:nif_dec(N)). -nif_dec(N) -> 0. +nif_dec(_) -> 0. dec(N) -> loaded(10000), diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl index 0235f624ce..091e960610 100644 --- a/erts/emulator/test/trace_local_SUITE.erl +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -814,9 +814,6 @@ loop(D1,D2,D3,0) -> loop(D1,D2,D3,N) -> max(N,loop(D1,D2,D3,N-1)). -max(A, B) when A > B -> A; -max(_, B) -> B. - exported_wrap(Val) -> exported(Val). diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl index 666bd60511..45987cc319 100644 --- a/erts/emulator/test/trace_meta_SUITE.erl +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -613,11 +613,6 @@ loop(D1,D2,D3,0) -> loop(D1,D2,D3,N) -> max(N,loop(D1,D2,D3,N-1)). -max(A,B) when A > B -> - A; -max(_A,B) -> - B. - id(X) -> X. diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl index c1f171d9b5..bfc3910742 100644 --- a/erts/emulator/test/tuple_SUITE.erl +++ b/erts/emulator/test/tuple_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -99,7 +99,7 @@ t_tuple_size(Config) when is_list(Config) -> ludicrous_tuple_size(T) when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok; -ludicrous_tuple_size(T) -> error. +ludicrous_tuple_size(_) -> error. %% Tests element/2. diff --git a/erts/emulator/utils/loaded b/erts/emulator/utils/loaded new file mode 100644 index 0000000000..99a66e7fdb --- /dev/null +++ b/erts/emulator/utils/loaded @@ -0,0 +1,44 @@ +%% -*- erlang -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Run like: +%% $ERL_TOP/bin/escript erts/emulator/utils/loaded + +-mode(compile). + +main(_) -> + LibDir = code:lib_dir(), + io:format("Library root is ~s\n", [LibDir]), + Wc = filename:join(LibDir, "*/ebin/*.beam"), + Beams = filelib:wildcard(Wc), + BeamFileSize = lists:sum([filelib:file_size(Beam) || Beam <- Beams]), + io:format("~w BEAM files containing ~w bytes\n", + [length(Beams),BeamFileSize]), + Ms = [list_to_atom(filename:rootname(filename:basename(Beam))) || + Beam <- Beams], + [{module,_} = code:ensure_loaded(M) || M <- Ms], + <<"Current code: ",T/binary>> = erlang:system_info(loaded), + Digits = grab_digits(T), + io:format("~w modules comprising ~s words when loaded\n", + [length(Ms),Digits]). + +grab_digits(<<H,T/binary>>) when $0 =< H, H =< $9 -> + [H|grab_digits(T)]; +grab_digits(<<$\n,_/binary>>) -> []. diff --git a/lib/common_test/doc/src/run_test_chapter.xml b/lib/common_test/doc/src/run_test_chapter.xml index 7b485bdc35..f052adf25e 100644 --- a/lib/common_test/doc/src/run_test_chapter.xml +++ b/lib/common_test/doc/src/run_test_chapter.xml @@ -368,15 +368,17 @@ either one or more suites, one or more test case groups, or one or more test cases in a group or suite.</p> <p>An arbitrary number of test terms may be declared in sequence. - Common Test will compile the terms into one or more tests to be - performed in one resulting test run. Note that a term that + Common Test will by default compile the terms into one or more tests + to be performed in one resulting test run. Note that a term that specifies a set of test cases will "swallow" one that only specifies a subset of these cases. E.g. the result of merging one term that specifies that all cases in suite S should be executed, with another term specifying only test case X and Y in S, is a test of all cases in S. However, if a term specifying test case X and Y in S is merged with a term specifying case Z - in S, the result is a test of X, Y and Z in S.</p> + in S, the result is a test of X, Y and Z in S. To disable this + behaviour, it is possible in test specification to set the + <c>merge_tests</c> term to <c>false</c>.</p> <p>A test term can also specify one or more test suites, groups, or test cases to be skipped. Skipped suites, groups and cases are not executed and show up in the HTML test log files as @@ -435,6 +437,8 @@ {userconfig, NodeRefs, {CallbackModule, ConfigStrings}}. {alias, DirAlias, Dir}. + + {merge_tests, Bool}. {logdir, LogDir}. {logdir, NodeRefs, LogDir}. diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 2b6abefb72..2c7cd3577c 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -68,7 +68,8 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% Create initial list of {Node,{Run,Skip}} tuples NodeList = lists:map(fun(N) -> {N,{[],[]}} end, list_nodes(TestSpec)), %% Get all Run tests sorted per node basis. - NodeList1 = run_per_node(Run,NodeList), + NodeList1 = run_per_node(Run,NodeList, + TestSpec#testspec.merge_tests), %% Get all Skip entries sorted per node basis. NodeList2 = skip_per_node(Skip,NodeList1), %% Change representation. @@ -89,11 +90,17 @@ prepare_tests(TestSpec) when is_record(TestSpec,testspec) -> %% run_per_node/2 takes the Run list as input and returns a list %% of {Node,RunPerNode,[]} tuples where the tests have been sorted %% on a per node basis. -run_per_node([{{Node,Dir},Test}|Ts],Result) -> +run_per_node([{{Node,Dir},Test}|Ts],Result, MergeTests) -> {value,{Node,{Run,Skip}}} = lists:keysearch(Node,1,Result), - Run1 = merge_tests(Dir,Test,Run), - run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result)); -run_per_node([],Result) -> + Run1 = case MergeTests of + false -> + append({Dir, Test}, Run); + true -> + merge_tests(Dir,Test,Run) + end, + run_per_node(Ts,insert_in_order({Node,{Run1,Skip}},Result), + MergeTests); +run_per_node([],Result,_) -> Result. merge_tests(Dir,Test={all,_},TestDirs) -> @@ -281,6 +288,8 @@ collect_tests(Terms,TestSpec,Relaxed) -> {Terms2, TestSpec3} = filter_init_terms(Terms, [], TestSpec2), add_tests(Terms2,TestSpec3). +get_global([{merge_tests, Bool} | Ts], Spec) -> + get_global(Ts,Spec#testspec{ merge_tests = Bool }); get_global([{alias,Ref,Dir}|Ts],Spec=#testspec{alias=Refs}) -> get_global(Ts,Spec#testspec{alias=[{Ref,get_absdir(Dir,Spec)}|Refs]}); get_global([{node,Ref,Node}|Ts],Spec=#testspec{nodes=Refs}) -> @@ -668,7 +677,7 @@ add_tests([{suites,Node,Dir,Ss}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Tests), + Ss,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- groups --- @@ -694,13 +703,15 @@ add_tests([{groups,Node,Dir,Suite,Gs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,all,Tests), + Suite,Gs,all,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{groups,Node,Dir,Suite,Gs,{cases,TCs}}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,TCs,Tests), + Suite,Gs,TCs,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- cases --- @@ -715,7 +726,7 @@ add_tests([{cases,Node,Dir,Suite,Cs}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = insert_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Tests), + Suite,Cs,Tests, Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_suites --- @@ -730,7 +741,8 @@ add_tests([{skip_suites,Node,Dir,Ss,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_suites(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Ss,Cmt,Tests), + Ss,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_groups --- @@ -752,13 +764,15 @@ add_tests([{skip_groups,Node,Dir,Suite,Gs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,all,Cmt,Tests), + Suite,Gs,all,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); add_tests([{skip_groups,Node,Dir,Suite,Gs,{cases,TCs},Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_groups(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Gs,TCs,Cmt,Tests), + Suite,Gs,TCs,Cmt,Tests, + Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- skip_cases --- @@ -773,7 +787,7 @@ add_tests([{skip_cases,Node,Dir,Suite,Cs,Cmt}|Ts],Spec) -> Tests = Spec#testspec.tests, Tests1 = skip_cases(ref2node(Node,Spec#testspec.nodes), ref2dir(Dir,Spec#testspec.alias), - Suite,Cs,Cmt,Tests), + Suite,Cs,Cmt,Tests,Spec#testspec.merge_tests), add_tests(Ts,Spec#testspec{tests=Tests1}); %% --- handled/errors --- @@ -783,6 +797,9 @@ add_tests([{alias,_,_}|Ts],Spec) -> % handled add_tests([{node,_,_}|Ts],Spec) -> % handled add_tests(Ts,Spec); +add_tests([{merge_tests, _} | Ts], Spec) -> % handled + add_tests(Ts,Spec); + %% check if it's a CT term that has bad format or if the user seems to %% have added something of his/her own, which we'll let pass if relaxed %% mode is enabled. @@ -835,17 +852,22 @@ separate([],_,_,_) -> %% {Suite2,[{GrOrCase21,{skip,Cmt}},GrOrCase22,...]},...]} %% GrOrCase = {GroupName,[Case1,Case2,...]} | Case -insert_suites(Node,Dir,[S|Ss],Tests) -> - Tests1 = insert_cases(Node,Dir,S,all,Tests), - insert_suites(Node,Dir,Ss,Tests1); -insert_suites(_Node,_Dir,[],Tests) -> +insert_suites(Node,Dir,[S|Ss],Tests, MergeTests) -> + Tests1 = insert_cases(Node,Dir,S,all,Tests,MergeTests), + insert_suites(Node,Dir,Ss,Tests1,MergeTests); +insert_suites(_Node,_Dir,[],Tests,_MergeTests) -> Tests; -insert_suites(Node,Dir,S,Tests) -> - insert_suites(Node,Dir,[S],Tests). +insert_suites(Node,Dir,S,Tests,MergeTests) -> + insert_suites(Node,Dir,[S],Tests,MergeTests). -insert_groups(Node,Dir,Suite,Group,Cases,Tests) when is_atom(Group) -> - insert_groups(Node,Dir,Suite,[Group],Cases,Tests); -insert_groups(Node,Dir,Suite,Groups,Cases,Tests) when +insert_groups(Node,Dir,Suite,Group,Cases,Tests,MergeTests) + when is_atom(Group) -> + insert_groups(Node,Dir,Suite,[Group],Cases,Tests,MergeTests); +insert_groups(Node,Dir,Suite,Groups,Cases,Tests,false) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Groups1 = [{Gr,Cases} || Gr <- Groups], + append({{Node,Dir},[{Suite,Groups1}]},Tests); +insert_groups(Node,Dir,Suite,Groups,Cases,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> @@ -859,9 +881,10 @@ insert_groups(Node,Dir,Suite,Groups,Cases,Tests) when Groups1 = [{Gr,Cases} || Gr <- Groups], insert_in_order({{Node,Dir},[{Suite,Groups1}]},Tests) end; -insert_groups(Node,Dir,Suite,Groups,Case,Tests) when is_atom(Case) -> +insert_groups(Node,Dir,Suite,Groups,Case,Tests, MergeTests) + when is_atom(Case) -> Cases = if Case == all -> all; true -> [Case] end, - insert_groups(Node,Dir,Suite,Groups,Cases,Tests). + insert_groups(Node,Dir,Suite,Groups,Cases,Tests, MergeTests). insert_groups1(_Suite,_Groups,all) -> all; @@ -891,7 +914,9 @@ insert_groups2([Group={GrName,Cases}|Groups],GrAndCases) -> insert_groups2([],GrAndCases) -> GrAndCases. -insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> +insert_cases(Node,Dir,Suite,Cases,Tests,false) when is_list(Cases) -> + append({{Node,Dir},[{Suite,Cases}]},Tests); +insert_cases(Node,Dir,Suite,Cases,Tests,true) when is_list(Cases) -> case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},[{all,_}]}} -> Tests; @@ -901,8 +926,8 @@ insert_cases(Node,Dir,Suite,Cases,Tests) when is_list(Cases) -> false -> insert_in_order({{Node,Dir},[{Suite,Cases}]},Tests) end; -insert_cases(Node,Dir,Suite,Case,Tests) when is_atom(Case) -> - insert_cases(Node,Dir,Suite,[Case],Tests). +insert_cases(Node,Dir,Suite,Case,Tests,MergeTests) when is_atom(Case) -> + insert_cases(Node,Dir,Suite,[Case],Tests,MergeTests). insert_cases1(_Suite,_Cases,all) -> all; @@ -917,22 +942,28 @@ insert_cases1(Suite,Cases,Suites0) -> insert_in_order({Suite,Cases},Suites0) end. -skip_suites(Node,Dir,[S|Ss],Cmt,Tests) -> - Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests), - skip_suites(Node,Dir,Ss,Cmt,Tests1); -skip_suites(_Node,_Dir,[],_Cmt,Tests) -> +skip_suites(Node,Dir,[S|Ss],Cmt,Tests,MergeTests) -> + Tests1 = skip_cases(Node,Dir,S,all,Cmt,Tests,MergeTests), + skip_suites(Node,Dir,Ss,Cmt,Tests1,MergeTests); +skip_suites(_Node,_Dir,[],_Cmt,Tests,_MergeTests) -> Tests; -skip_suites(Node,Dir,S,Cmt,Tests) -> - skip_suites(Node,Dir,[S],Cmt,Tests). - -skip_groups(Node,Dir,Suite,Group,all,Cmt,Tests) when is_atom(Group) -> - skip_groups(Node,Dir,Suite,[Group],all,Cmt,Tests); -skip_groups(Node,Dir,Suite,Group,Cases,Cmt,Tests) when is_atom(Group) -> - skip_groups(Node,Dir,Suite,[Group],Cases,Cmt,Tests); -skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests) when is_atom(Case), - Case =/= all -> - skip_groups(Node,Dir,Suite,Groups,[Case],Cmt,Tests); -skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests) when +skip_suites(Node,Dir,S,Cmt,Tests,MergeTests) -> + skip_suites(Node,Dir,[S],Cmt,Tests,MergeTests). + +skip_groups(Node,Dir,Suite,Group,all,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],all,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Group,Cases,Cmt,Tests,MergeTests) + when is_atom(Group) -> + skip_groups(Node,Dir,Suite,[Group],Cases,Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case),Case =/= all -> + skip_groups(Node,Dir,Suite,Groups,[Case],Cmt,Tests,MergeTests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,false) when + ((Cases == all) or is_list(Cases)) and is_list(Groups) -> + Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,true) when ((Cases == all) or is_list(Cases)) and is_list(Groups) -> Suites = case lists:keysearch({Node,Dir},1,Tests) of @@ -943,9 +974,10 @@ skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests) when end, Suites1 = skip_groups1(Suite,[{Gr,Cases} || Gr <- Groups],Cmt,Suites), insert_in_order({{Node,Dir},Suites1},Tests); -skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests) when is_atom(Case) -> +skip_groups(Node,Dir,Suite,Groups,Case,Cmt,Tests,MergeTests) + when is_atom(Case) -> Cases = if Case == all -> all; true -> [Case] end, - skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests). + skip_groups(Node,Dir,Suite,Groups,Cases,Cmt,Tests,MergeTests). skip_groups1(Suite,Groups,Cmt,Suites0) -> SkipGroups = lists:map(fun(Group) -> @@ -959,7 +991,10 @@ skip_groups1(Suite,Groups,Cmt,Suites0) -> insert_in_order({Suite,SkipGroups},Suites0) end. -skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,false) when is_list(Cases) -> + Suites1 = skip_cases1(Suite,Cases,Cmt,[]), + append({{Node,Dir},Suites1},Tests); +skip_cases(Node,Dir,Suite,Cases,Cmt,Tests,true) when is_list(Cases) -> Suites = case lists:keysearch({Node,Dir},1,Tests) of {value,{{Node,Dir},Suites0}} -> @@ -969,8 +1004,8 @@ skip_cases(Node,Dir,Suite,Cases,Cmt,Tests) when is_list(Cases) -> end, Suites1 = skip_cases1(Suite,Cases,Cmt,Suites), insert_in_order({{Node,Dir},Suites1},Tests); -skip_cases(Node,Dir,Suite,Case,Cmt,Tests) when is_atom(Case) -> - skip_cases(Node,Dir,Suite,[Case],Cmt,Tests). +skip_cases(Node,Dir,Suite,Case,Cmt,Tests,MergeTests) when is_atom(Case) -> + skip_cases(Node,Dir,Suite,[Case],Cmt,Tests,MergeTests). skip_cases1(Suite,Cases,Cmt,Suites0) -> SkipCases = lists:map(fun(C) -> @@ -984,6 +1019,9 @@ skip_cases1(Suite,Cases,Cmt,Suites0) -> insert_in_order({Suite,SkipCases},Suites0) end. +append(Elem, List) -> + List ++ [Elem]. + insert_in_order([E|Es],List) -> List1 = insert_elem(E,List,[]), insert_in_order(Es,List1); @@ -1056,6 +1094,7 @@ valid_terms() -> {userconfig,2}, {userconfig,3}, {alias,3}, + {merge_tests,1}, {logdir,2}, {logdir,3}, {label,2}, diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index 4ed29bdcd1..f0255c533c 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -41,7 +41,8 @@ multiply_timetraps=[], scale_timetraps=[], alias=[], - tests=[]}). + tests=[], + merge_tests = true }). -record(cover, {app=none, level=details, diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index c2a7bd8fd7..e080e074bf 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -67,7 +67,21 @@ all() -> skip_group_testcase, topgroup, subgroup, skip_subgroup, subgroup_all_testcases, skip_subgroup_all_testcases, subgroup_testcase, skip_subgroup_testcase, - sub_skipped_by_top, testcase_in_multiple_groups]. + sub_skipped_by_top, testcase_in_multiple_groups, + order_of_tests_in_multiple_dirs_no_merge_tests, + order_of_tests_in_multiple_suites_no_merge_tests, + order_of_suites_in_multiple_dirs_no_merge_tests, + order_of_groups_in_multiple_dirs_no_merge_tests, + order_of_groups_in_multiple_suites_no_merge_tests, + order_of_tests_in_multiple_dirs, + order_of_tests_in_multiple_suites, + order_of_suites_in_multiple_dirs, + order_of_groups_in_multiple_dirs, + order_of_groups_in_multiple_suites, + order_of_tests_in_multiple_suites_with_skip_no_merge_tests, + order_of_tests_in_multiple_suites_with_skip, + all_plus_one_tc_no_merge_tests, + all_plus_one_tc]. groups() -> []. @@ -78,7 +92,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - %%-------------------------------------------------------------------- %% TEST CASES %%-------------------------------------------------------------------- @@ -370,6 +383,223 @@ testcase_in_multiple_groups(Config) when is_list(Config) -> setup_and_execute(testcase_in_multiple_groups, TestSpec, Config). %%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{merge_tests, false}, + {cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir2,groups_22_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], + + setup_and_execute(order_of_tests_in_multiple_dirs_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_suites_no_merge_tests(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{merge_tests, false}, + {cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir1,groups_11_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], + + setup_and_execute(order_of_tests_in_multiple_suites_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_suites_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{merge_tests, false}, + {suites,TestDir1,groups_12_SUITE}, + {suites,TestDir2,groups_22_SUITE}, + {suites,TestDir1,groups_11_SUITE}], + + setup_and_execute(order_of_suites_in_multiple_dirs_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_groups_in_multiple_dirs_no_merge_tests(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{merge_tests, false}, + {groups,TestDir1,groups_12_SUITE,test_group_1a}, + {groups,TestDir2,groups_22_SUITE,test_group_1a}, + {groups,TestDir1,groups_12_SUITE,test_group_1b}], + + setup_and_execute(order_of_groups_in_multiple_dirs_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_groups_in_multiple_suites_no_merge_tests(Config) + when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{merge_tests, false}, + {groups,TestDir1,groups_12_SUITE,test_group_1a}, + {groups,TestDir1,groups_11_SUITE,test_group_1a}, + {groups,TestDir1,groups_12_SUITE,test_group_1b}], + + setup_and_execute(order_of_groups_in_multiple_suites_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_suites_with_skip_no_merge_tests(Config) + when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{merge_tests, false}, + {cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir1,groups_11_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}, + {cases,TestDir1,groups_11_SUITE,[testcase_2]}, + {skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it"}], + + setup_and_execute( + order_of_tests_in_multiple_suites_with_skip_no_merge_tests, + TestSpec, Config). + + +%%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_dirs(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir2,groups_22_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], + + setup_and_execute(order_of_tests_in_multiple_dirs, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_suites(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir1,groups_11_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}], + + setup_and_execute(order_of_tests_in_multiple_suites, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_suites_in_multiple_dirs(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{suites,TestDir1,groups_12_SUITE}, + {suites,TestDir2,groups_22_SUITE}, + {suites,TestDir1,groups_11_SUITE}], + + setup_and_execute(order_of_suites_in_multiple_dirs, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_groups_in_multiple_dirs(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestDir2 = filename:join(DataDir, "groups_2"), + TestSpec = [{groups,TestDir1,groups_12_SUITE,test_group_1a}, + {groups,TestDir2,groups_22_SUITE,test_group_1a}, + {groups,TestDir1,groups_12_SUITE,test_group_1b}], + + setup_and_execute(order_of_groups_in_multiple_dirs, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_groups_in_multiple_suites(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{groups,TestDir1,groups_12_SUITE,test_group_1a}, + {groups,TestDir1,groups_11_SUITE,test_group_1a}, + {groups,TestDir1,groups_12_SUITE,test_group_1b}], + + setup_and_execute(order_of_groups_in_multiple_suites, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +order_of_tests_in_multiple_suites_with_skip(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{cases,TestDir1,groups_12_SUITE,[testcase_1a]}, + {cases,TestDir1,groups_11_SUITE,[testcase_1]}, + {cases,TestDir1,groups_12_SUITE,[testcase_1b]}, + {cases,TestDir1,groups_11_SUITE,[testcase_2]}, + {skip_cases,TestDir1,groups_12_SUITE,[testcase_1b],"Skip it!"}], + + setup_and_execute(order_of_tests_in_multiple_suites_with_skip, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +all_plus_one_tc_no_merge_tests(Config) when is_list(Config) -> + + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{merge_tests,false}, + {suites,TestDir1,groups_12_SUITE}, + {cases,TestDir1,groups_12_SUITE,[testcase_1a]}], + + setup_and_execute(all_plus_one_tc_no_merge_tests, + TestSpec, Config). + +%%%----------------------------------------------------------------- +%%% + +all_plus_one_tc(Config) when is_list(Config) -> + + DataDir = ?config(data_dir, Config), + + TestDir1 = filename:join(DataDir, "groups_1"), + TestSpec = [{suites,TestDir1,groups_12_SUITE}, + {cases,TestDir1,groups_12_SUITE,[testcase_1a]}], + + setup_and_execute(all_plus_one_tc, + TestSpec, Config). + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -432,6 +662,719 @@ events_to_check(_, 0) -> events_to_check(Test, N) -> test_events(Test) ++ events_to_check(Test, N-1). +test_events(all_suites) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{simple_1_SUITE,init_per_suite}}, + {?eh,tc_done,{simple_1_SUITE,end_per_suite,'_'}}, + {?eh,tc_start,{simple_2_SUITE,init_per_suite}}, + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_done,{simple_2_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_all_suites) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_user_skip,{simple_1_SUITE,all,"SKIPPED!"}}, + {?eh,tc_user_skip,{simple_2_SUITE,all,"SKIPPED!"}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(suite) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{simple_1_SUITE,init_per_suite}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{simple_1_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_suite) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_user_skip,{simple_1_SUITE,all,"SKIPPED!"}}, + {?eh,tc_done,{simple_2_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{simple_1_SUITE,init_per_suite}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{simple_1_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_user_skip,{simple_1_SUITE,all,"SKIPPED!"}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(testcase) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{simple_1_SUITE,init_per_suite}}, + {?eh,test_stats,{1,0,{0,0}}}, + {negative,{?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{simple_1_SUITE,end_per_suite,'_'}}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_testcase) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{simple_1_SUITE,init_per_suite}}, + {?eh,tc_user_skip,{simple_1_SUITE,tc1,"SKIPPED!"}}, + {?eh,tc_start,{simple_1_SUITE,tc2}}, + {?eh,tc_start,{simple_1_SUITE,end_per_suite}}, + + {?eh,tc_start,{simple_2_SUITE,init_per_suite}}, + {?eh,tc_user_skip,{simple_2_SUITE,tc2,"SKIPPED!"}}, + {?eh,tc_start,{simple_2_SUITE,tc1}}, + {?eh,test_stats,{2,0,{2,0}}}, + {?eh,tc_start,{simple_2_SUITE,end_per_suite}}, + + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(all_groups) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,test_stats,{12,0,{0,0}}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_all_groups) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1a},"SKIPPED!"}}, + {?eh,test_stats,{0,0,{1,0}}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}}, + {?eh,test_stats,{0,0,{2,0}}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_2},"SKIPPED!"}}, + {?eh,test_stats,{0,0,{3,0}}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_4},"SKIPPED!"}}, + {?eh,test_stats,{0,0,{4,0}}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(group) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1b}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_group) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1b}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, + + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}}, + {?eh,test_stats,{2,0,{1,0}}}, + {negative,{?eh,tc_user_skip,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(group_all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1b}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_group_all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1a},"SKIPPED!"}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}}, + {?eh,test_stats,{0,0,{2,0}}}, + {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(group_testcase) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, + {?eh,test_stats,{1,0,{0,0}}}, + {negative,{?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}}, + + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_group_testcase) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1a,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1a}}, + {?eh,tc_user_skip,{groups_11_SUITE,testcase_1b,"SKIPPED!"}}, + {?eh,test_stats,{1,0,{1,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, + + {?eh,tc_start,{groups_11_SUITE,{init_per_group,test_group_1b,[]}}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1b}}, + {?eh,tc_user_skip,{groups_11_SUITE,testcase_1a,"SKIPPED!"}}, + {?eh,test_stats,{2,0,{2,0}}}, + {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1b,[]},'_'}}, + + {negative,{?eh,tc_user_skip,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(topgroup) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]},ok}}, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[{repeat,2}]}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[{repeat,2}]}}} + ], + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[]}}} + ], + {?eh,test_stats,{6,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]},ok}}]}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]},ok}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, + [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], + {shuffle, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]},ok}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]}}}, + {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]},ok}} + ]}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]},ok}} + ]}, + {?eh,test_stats,{12,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]},ok}}]}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}], + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(subgroup) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]},ok}}, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[{repeat,2}]}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[{repeat,2}]}}} + ], + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[]}}} + ], + {?eh,test_stats,{4,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]},ok}}]}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_subgroup) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]},ok}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, + [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], + {?eh,tc_user_skip, + {groups_12_SUITE,{group,test_group_8},"SKIPPED!"}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]},ok}} + ]}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]},ok}}]}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}], + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(subgroup_all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]},ok}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, + [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], + {shuffle, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]},ok}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]}}}, + {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]},ok}} + ]}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]},ok}} + ]}, + {?eh,test_stats,{6,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]},ok}}]}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}], + + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]},ok}}, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[{repeat,2}]}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[{repeat,2}]}}} + ], + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,test_stats,{10,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[]}}} + ], + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]},ok}}]}, + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_subgroup_all_testcases) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_4,[]},ok}}, + {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_5},"SKIPPED!"}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}, + {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_4,[]},ok}} + ], + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(subgroup_testcase) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]},ok}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, + [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]},ok}} + ]}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]},ok}}]}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}], + + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_2,[parallel]},ok}}, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[{repeat,2}]}}}, + {?eh,test_stats,{2,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[{repeat,2}]}}} + ], + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_3,[]}}}, + {?eh,test_stats,{3,0,{0,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_3,[]}}} + ], + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_2,[parallel]},ok}}]}, + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(skip_subgroup_testcase) -> + [ + + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_4,[]}}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_5,[parallel]},ok}}, + {parallel, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_6,[parallel]},ok}}, + [{?eh,tc_start,{groups_12_SUITE,{init_per_group,test_group_7,'_'}}}, + {?eh,tc_user_skip, {groups_12_SUITE,testcase_7a,"SKIPPED!"}}, + {?eh,test_stats,{1,0,{1,0}}}, + {?eh,tc_user_skip, {groups_12_SUITE,testcase_7b,"SKIPPED!"}}, + {?eh,test_stats,{1,0,{2,0}}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_7,'_'}}}], + {shuffle, + [{?eh,tc_start, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]}}}, + {?eh,tc_done, + {groups_12_SUITE,{init_per_group,test_group_8, + [{shuffle,'_'},sequence]},ok}}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]}}}, + {?eh,tc_done,{groups_12_SUITE,{end_per_group,test_group_8, + [shuffle,sequence]},ok}} + ]}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_6,[parallel]},ok}} + ]}, + {?eh,test_stats,{4,0,{2,0}}}, + {?eh,tc_start, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]}}}, + {?eh,tc_done, + {groups_12_SUITE,{end_per_group,test_group_5,[parallel]},ok}}]}, + {?eh,tc_start,{groups_12_SUITE,{end_per_group,test_group_4,[]}}}], + + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + + ]; + +test_events(sub_skipped_by_top) -> + [ + {?eh,start_logging,'_'}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + + {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, + + {negative, + {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}}, + + {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} + ]; + +test_events(testcase_in_multiple_groups) -> + []; + +test_events(order_of_tests_in_multiple_dirs_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done, {groups_12_SUITE,testcase_1a, + {failed,{error,{test_case_failed,no_group_data}}}}}, + {?eh,tc_start,{groups_22_SUITE,testcase_1}}, + {?eh,tc_done,{groups_22_SUITE,testcase_1,ok}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1b}}, + {?eh,tc_done, {groups_12_SUITE,testcase_1b, + {failed,{error,{test_case_failed,no_group_data}}}}}, + {?eh,stop_logging,[]} + ]; +test_events(order_of_tests_in_multiple_suites_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1}}, + {?eh,tc_done,{groups_11_SUITE,testcase_1,ok}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1b}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1b,'_'}}, + {?eh,stop_logging,[]} + ]; +test_events(order_of_suites_in_multiple_dirs_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,'_'}}, + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_11_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + {?eh,stop_logging,[]}]; +test_events(order_of_groups_in_multiple_dirs_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_22_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1b,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, + + {?eh,stop_logging,[]}]; +test_events(order_of_groups_in_multiple_suites_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_11_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_11_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1b,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, + + {?eh,stop_logging,[]}]; +test_events(order_of_tests_in_multiple_suites_with_skip_no_merge_tests) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1}}, + {?eh,tc_done,{groups_11_SUITE,testcase_1,ok}}, + {?eh,tc_user_skip,{groups_12_SUITE,testcase_1b,'_'}}, + {?eh,tc_start,{groups_11_SUITE,testcase_2}}, + {?eh,tc_done,{groups_11_SUITE,testcase_2,ok}}, + {?eh,stop_logging,[]} + ]; + +test_events(order_of_tests_in_multiple_dirs) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done, + {groups_12_SUITE,testcase_1a, + {failed,{error,{test_case_failed,no_group_data}}}}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1b}}, + {?eh,tc_done, + {groups_12_SUITE,testcase_1b, + {failed,{error,{test_case_failed,no_group_data}}}}}, + {?eh,tc_start,{groups_22_SUITE,testcase_1}}, + {?eh,tc_done,{groups_22_SUITE,testcase_1,ok}}, + {?eh,stop_logging,[]} + ]; +test_events(order_of_tests_in_multiple_suites) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, + + {?eh,tc_start,{groups_12_SUITE,testcase_1b}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1b,'_'}}, + + {?eh,tc_start,{groups_11_SUITE,testcase_1}}, + {?eh,tc_done,{groups_11_SUITE,testcase_1,ok}}, + {?eh,stop_logging,[]} + ]; +test_events(order_of_suites_in_multiple_dirs) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_12_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + + {?eh,tc_start,{groups_11_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_11_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_11_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_11_SUITE,end_per_suite,'_'}}, + + {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,init_per_suite,'_'}}, + {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,'_'}}, + {?eh,stop_logging,[]}]; +test_events(order_of_groups_in_multiple_dirs) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1b,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, + + {?eh,tc_start, {groups_22_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_22_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,stop_logging,[]}]; +test_events(order_of_groups_in_multiple_suites) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,tc_start, {groups_12_SUITE,{init_per_group,test_group_1b,'_'}}}, + {?eh,tc_done, {groups_12_SUITE,{end_per_group,test_group_1b,'_'},'_'}}, + + {?eh,tc_start, {groups_11_SUITE,{init_per_group,test_group_1a,'_'}}}, + {?eh,tc_done, {groups_11_SUITE,{end_per_group,test_group_1a,'_'},'_'}}, + + {?eh,stop_logging,[]}]; + +test_events(order_of_tests_in_multiple_suites_with_skip) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,testcase_1a}}, + {?eh,tc_done,{groups_12_SUITE,testcase_1a,'_'}}, + {?eh,tc_user_skip,{groups_12_SUITE,testcase_1b,'_'}}, + {?eh,tc_start,{groups_11_SUITE,testcase_1}}, + {?eh,tc_done,{groups_11_SUITE,testcase_1,ok}}, + {?eh,tc_start,{groups_11_SUITE,testcase_2}}, + {?eh,tc_done,{groups_11_SUITE,testcase_2,ok}}, + {?eh,stop_logging,[]} + ]; + +test_events(all_plus_one_tc_no_merge_tests) -> + + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {?eh,stop_logging,[]} + ]; + +test_events(all_plus_one_tc) -> + + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, + {negative,{?eh,tc_start,{groups_12_SUITE,init_per_suite}}, + {?eh,stop_logging,[]}} + ]; + test_events(_) -> [ ]. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 38603a76a1..ce8a5bf864 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -112,9 +112,10 @@ noenv_forms(Forms, Opt) when is_atom(Opt) -> -spec noenv_output_generated([option()]) -> boolean(). noenv_output_generated(Opts) -> + {_,Passes} = passes(file, expand_opts(Opts)), any(fun ({save_binary,_F}) -> true; (_Other) -> false - end, passes(file, expand_opts(Opts))). + end, Passes). %% %% Local functions @@ -243,26 +244,12 @@ internal(Master, Input, Opts) -> end}. internal({forms,Forms}, Opts) -> - Ps = passes(forms, Opts), + {_,Ps} = passes(forms, Opts), internal_comp(Ps, "", "", #compile{code=Forms,options=Opts}); internal({file,File}, Opts) -> - Ps = passes(file, Opts), + {Ext,Ps} = passes(file, Opts), Compile = #compile{options=Opts}, - case member(from_core, Opts) of - true -> internal_comp(Ps, File, ".core", Compile); - false -> - case member(from_beam, Opts) of - true -> - internal_comp(Ps, File, ".beam", Compile); - false -> - case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - internal_comp(Ps, File, ".S", Compile); - false -> - internal_comp(Ps, File, ".erl", Compile) - end - end - end. + internal_comp(Ps, File, Ext, Compile). internal_comp(Passes, File, Suffix, St0) -> Dir = filename:dirname(File), @@ -370,42 +357,52 @@ mpf(Ms) -> [{File,[M || {F,M} <- Ms, F =:= File]} || File <- lists:usort([F || {F,_} <- Ms])]. -%% passes(forms|file, [Option]) -> [{Name,PassFun}] -%% Figure out which passes that need to be run. +%% passes(forms|file, [Option]) -> {Extension,[{Name,PassFun}]} +%% Figure out the extension of the input file and which passes +%% that need to be run. -passes(forms, Opts) -> - case member(from_core, Opts) of - true -> - select_passes(core_passes(), Opts); - false -> - select_passes(standard_passes(), Opts) +passes(Type, Opts) -> + {Ext,Passes0} = passes_1(Opts), + Passes1 = case Type of + file -> Passes0; + forms -> tl(Passes0) + end, + Passes = select_passes(Passes1, Opts), + + %% If the last pass saves the resulting binary to a file, + %% insert a first pass to remove the file (unless the + %% source file is a BEAM file). + {Ext,case last(Passes) of + {save_binary,_Fun} -> + case Passes of + [{read_beam_file,_}|_] -> + %% The BEAM is both input and output. + %% Don't remove it. + Passes; + _ -> + [?pass(remove_file)|Passes] + end; + _ -> + Passes + end}. + +passes_1([Opt|Opts]) -> + case pass(Opt) of + {_,_}=Res -> Res; + none -> passes_1(Opts) end; -passes(file, Opts) -> - case member(from_beam, Opts) of - true -> - Ps = [?pass(read_beam_file)|binary_passes()], - select_passes(Ps, Opts); - false -> - Ps = case member(from_asm, Opts) orelse member(asm, Opts) of - true -> - [?pass(beam_consult_asm)|asm_passes()]; - false -> - case member(from_core, Opts) of - true -> - [?pass(parse_core)|core_passes()]; - false -> - [?pass(parse_module)|standard_passes()] - end - end, - Fs = select_passes(Ps, Opts), - - %% If the last pass saves the resulting binary to a file, - %% insert a first pass to remove the file. - case last(Fs) of - {save_binary,_Fun} -> [?pass(remove_file)|Fs]; - _Other -> Fs - end - end. +passes_1([]) -> + {".erl",[?pass(parse_module)|standard_passes()]}. + +pass(from_core) -> + {".core",[?pass(parse_core)|core_passes()]}; +pass(from_asm) -> + {".S",[?pass(beam_consult_asm)|asm_passes()]}; +pass(asm) -> + pass(from_asm); +pass(from_beam) -> + {".beam",[?pass(read_beam_file)|binary_passes()]}; +pass(_) -> none. %% select_passes([Command], Opts) -> [{Name,Function}] %% Interpret the lists of commands to return a pure list of passes. diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index 9bd13f7032..e363a5387a 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,10 +20,12 @@ -module(v3_kernel_pp). --include("v3_kernel.hrl"). - -export([format/1]). +%%-define(INCLUDE_ANNOTATIONS, 1). + +-include("v3_kernel.hrl"). + %% These are "internal" structures in sys_kernel which are here for %% debugging purposes. -record(iset, {anno=[],vars,arg,body}). @@ -62,22 +64,21 @@ format(Node, Ctxt) -> end) end. -format_anno(Anno, Ctxt0, ObjFun) -> - case annotations_enabled() of - true -> - Ctxt1 = ctxt_bump_indent(Ctxt0, 1), - ["( ", - ObjFun(Ctxt0), - nl_indent(Ctxt1), - "-| ",io_lib:write(Anno), - " )"]; - false -> - ObjFun(Ctxt0) - end. -%% By default, don't show annotations since they clutter up the output. -annotations_enabled() -> - false. +-ifndef(INCLUDE_ANNOTATIONS). +%% Don't include annotations (for readability). +format_anno(_Anno, Ctxt, ObjFun) -> + ObjFun(Ctxt). +-else. +%% Include annotations (for debugging of annotations). +format_anno(Anno, Ctxt0, ObjFun) -> + Ctxt1 = ctxt_bump_indent(Ctxt0, 1), + ["( ", + ObjFun(Ctxt0), + nl_indent(Ctxt1), + "-| ",io_lib:write(Anno), + " )"]. +-endif. %% format_1(Kexpr, Context) -> string(). diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index fe72fbb143..c430b12b70 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -231,7 +231,7 @@ one_test({C_bin, E_bin, Str, Result}) -> ok; %% For situations where the final bits may not matter, like %% for floats: - N when integer(N) -> + N when is_integer(N) -> io:format("Info: compiled and interpreted differ in the" " last bytes:~n ~p, ~p.~n", [bitstring_to_list(C_bin), bitstring_to_list(E_bin)]), diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 6cd133ee39..ba225b66d0 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -163,7 +163,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) -> beam_compiler_7(doc) -> "Code snippet submitted from Ulf Wiger which fails in R3 Beam."; beam_compiler_7(suite) -> []; -beam_compiler_7(Config) when list(Config) -> +beam_compiler_7(Config) when is_list(Config) -> ?line done = empty(2, false). empty(N, Toggle) when N > 0 -> @@ -327,7 +327,7 @@ from(_, []) -> []. vsn_1(doc) -> "Test generation of 'vsn' attribute"; vsn_1(suite) -> []; -vsn_1(Conf) when list(Conf) -> +vsn_1(Conf) when is_list(Conf) -> ?line M = vsn_1, ?line compile_load(M, ?config(data_dir, Conf), Conf), @@ -351,7 +351,7 @@ vsn_1(Conf) when list(Conf) -> vsn_2(doc) -> "Test overriding of generation of 'vsn' attribute"; vsn_2(suite) -> []; -vsn_2(Conf) when list(Conf) -> +vsn_2(Conf) when is_list(Conf) -> ?line M = vsn_2, ?line compile_load(M, ?config(data_dir, Conf), Conf), @@ -367,7 +367,7 @@ vsn_2(Conf) when list(Conf) -> vsn_3(doc) -> "Test that different code yields different generated 'vsn'"; vsn_3(suite) -> []; -vsn_3(Conf) when list(Conf) -> +vsn_3(Conf) when is_list(Conf) -> ?line M = vsn_3, ?line compile_load(M, ?config(data_dir, Conf), Conf), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 7201edf4ac..482564a32b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -111,8 +111,8 @@ const_cond(Config) when is_list(Config) -> const_cond(T, Sz) -> case T of _X when false -> never; - _X when tuple(T), eq == eq, tuple_size(T) == Sz -> ok; - _X when tuple(T), eq == leq, tuple_size(T) =< Sz -> ok; + _X when is_tuple(T), eq == eq, tuple_size(T) == Sz -> ok; + _X when is_tuple(T), eq == leq, tuple_size(T) =< Sz -> ok; _X -> error end. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 6684b82751..7b9600c2f6 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2010. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -68,7 +68,7 @@ attribute(Config) when is_list(Config) -> ok. -define(comp(Name), - Name(Config) when list(Config) -> + Name(Config) when is_list(Config) -> try_inline(Name, Config)). ?comp(bsdecode). diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 6dd950eade..bcdcf2fd9f 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -180,7 +180,7 @@ empty_generator(Config) when is_list(Config) -> id(I) -> I. fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok; -fc(Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}}) +fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}}) when length(Args) =:= Arity -> true = test_server:is_native(?MODULE); fc(Args, {'EXIT',{{case_clause,ActualArgs},_}}) diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index d8799952a9..53d8c04169 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -41,7 +41,7 @@ smoke_disasm(Mod) when is_atom(Mod) -> smoke_disasm(code:which(Mod)); smoke_disasm(File) when is_list(File) -> Res = beam_disasm:file(File), - {beam_file,Mod} = {element(1, Res),element(2, Res)}. + {beam_file,_Mod} = {element(1, Res),element(2, Res)}. %% Retrieve the "interesting" compiler options (options for optimization %% and compatibility) for the given module. @@ -62,16 +62,16 @@ opt_opts(Mod) -> (_) -> false end, Opts). -%% Some test suites gets cloned (e.g. to "record_SUITE" to "record_no_opt_SUITE"), -%% but the data directory is not cloned. This function retrieves the path to -%% the original data directory. +%% Some test suites gets cloned (e.g. to "record_SUITE" to +%% "record_no_opt_SUITE"), but the data directory is not cloned. +%% This function retrieves the path to the original data directory. get_data_dir(Config) -> Data0 = ?config(data_dir, Config), - {ok,Data1,_} = regexp:sub(Data0, "_no_opt_SUITE", "_SUITE"), - {ok,Data2,_} = regexp:sub(Data1, "_post_opt_SUITE", "_SUITE"), - {ok,Data,_} = regexp:sub(Data2, "_inline_SUITE", "_SUITE"), - Data. + Opts = [{return,list}], + Data1 = re:replace(Data0, "_no_opt_SUITE", "_SUITE", Opts), + Data = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts), + re:replace(Data, "_inline_SUITE", "_SUITE", Opts). %% p_run(fun(Data) -> ok|error, List) -> ok %% Will fail the test case if there were any errors. diff --git a/lib/erl_interface/src/decode/decode_atom.c b/lib/erl_interface/src/decode/decode_atom.c index b247bd4e17..ef28838b79 100644 --- a/lib/erl_interface/src/decode/decode_atom.c +++ b/lib/erl_interface/src/decode/decode_atom.c @@ -31,6 +31,8 @@ int ei_decode_atom(const char *buf, int *index, char *p) len = get16be(s); + if (len > MAXATOMLEN) return -1; + if (p) { memmove(p,s,len); p[len] = (char)0; diff --git a/lib/erl_interface/src/decode/decode_pid.c b/lib/erl_interface/src/decode/decode_pid.c index 5f2aec3b44..48a0c68240 100644 --- a/lib/erl_interface/src/decode/decode_pid.c +++ b/lib/erl_interface/src/decode/decode_pid.c @@ -33,6 +33,8 @@ int ei_decode_pid(const char *buf, int *index, erlang_pid *p) if (get8(s) != ERL_ATOM_EXT) return -1; len = get16be(s); + + if (len > MAXATOMLEN) return -1; if (p) { memmove(p->node, s, len); diff --git a/lib/erl_interface/src/decode/decode_port.c b/lib/erl_interface/src/decode/decode_port.c index 7fb7d8d414..296ebae024 100644 --- a/lib/erl_interface/src/decode/decode_port.c +++ b/lib/erl_interface/src/decode/decode_port.c @@ -34,6 +34,8 @@ int ei_decode_port(const char *buf, int *index, erlang_port *p) len = get16be(s); + if (len > MAXATOMLEN) return -1; + if (p) { memmove(p->node, s, len); p->node[len] = (char)0; diff --git a/lib/erl_interface/src/decode/decode_ref.c b/lib/erl_interface/src/decode/decode_ref.c index 6fc2cd6533..691b51fe2d 100644 --- a/lib/erl_interface/src/decode/decode_ref.c +++ b/lib/erl_interface/src/decode/decode_ref.c @@ -35,6 +35,8 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p) len = get16be(s); + if (len > MAXATOMLEN) return -1; + if (p) { memmove(p->node, s, len); p->node[len] = (char)0; @@ -62,6 +64,7 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p) /* then the nodename */ if (get8(s) != ERL_ATOM_EXT) return -1; len = get16be(s); + if (len > MAXATOMLEN) return -1; if (p) { memmove(p->node, s, len); diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c index 3c8c946506..e77bd5db37 100644 --- a/lib/erl_interface/src/legacy/erl_connect.c +++ b/lib/erl_interface/src/legacy/erl_connect.c @@ -180,9 +180,7 @@ int erl_xconnect(Erl_IpAddr addr, char *alivename) * * Close a connection. FIXME call ei_close_connection() later. * - * Returns valid file descriptor on success and < 0 on failure. - * Set erl_errno to EHOSTUNREACH, ENOMEM, EIO or errno from socket(2) - * or connect(2). + * Returns 0 on success and -1 on failure. * ***************************************************************************/ @@ -250,7 +248,8 @@ int erl_send(int fd, ETERM *to ,ETERM *msg) return -1; } - strcpy(topid.node, (char *)ERL_PID_NODE(to)); + strncpy(topid.node, (char *)ERL_PID_NODE(to), sizeof(topid.node)); + topid.node[sizeof(topid.node)-1] = '\0'; topid.num = ERL_PID_NUMBER(to); topid.serial = ERL_PID_SERIAL(to); topid.creation = ERL_PID_CREATION(to); diff --git a/lib/erl_interface/src/legacy/erl_format.c b/lib/erl_interface/src/legacy/erl_format.c index 9848e9296a..b17269213f 100644 --- a/lib/erl_interface/src/legacy/erl_format.c +++ b/lib/erl_interface/src/legacy/erl_format.c @@ -116,7 +116,7 @@ static lvar *lvar_alloc(void) lvar *tmp; if ((tmp = ef.idle) == NULL) { - tmp = (lvar *) malloc(sizeof(lvar)); /* FIXME check result */ + tmp = (lvar *) erl_malloc(sizeof(lvar)); } else { tmp = ef.idle; diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c index 70949a7adf..5cfb5e2124 100644 --- a/lib/erl_interface/src/legacy/erl_marshal.c +++ b/lib/erl_interface/src/legacy/erl_marshal.c @@ -662,7 +662,7 @@ len = i #define STATIC_NODE_BUF_SZ 30 #define SET_NODE(node,node_buf,cp,len) \ -if (len >= STATIC_NODE_BUF_SZ) node = malloc(len+1); \ +if (len >= STATIC_NODE_BUF_SZ) node = erl_malloc(len+1); \ else node = node_buf; \ memcpy(node, cp, len); \ node[len] = '\0' @@ -1534,7 +1534,7 @@ static int cmp_string_list(unsigned char **e1, unsigned char **e2) { if ( e1_len < 256 ) { bp = buf; } else { - bp = malloc(5+(2*e1_len)+1); + bp = erl_malloc(5+(2*e1_len)+1); } bp[0] = ERL_LIST_EXT; diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c index af1a4a1f3a..6ef5d258ed 100644 --- a/lib/erl_interface/src/legacy/erl_timeout.c +++ b/lib/erl_interface/src/legacy/erl_timeout.c @@ -74,7 +74,7 @@ jmp_buf *timeout_setup(int ms) t.it_value.tv_usec = (ms % 1000) * 1000; /* get a jump buffer and save it */ - j = malloc(sizeof(*j)); /* FIXME check result */ + j = erl_malloc(sizeof(*j)); j->siginfo = s; push(j); diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c index 75c5dc9460..9b238c1e90 100644 --- a/lib/erl_interface/src/misc/ei_decode_term.c +++ b/lib/erl_interface/src/misc/ei_decode_term.c @@ -49,6 +49,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) return ei_decode_double(buf, index, &term->value.d_val); case ERL_ATOM_EXT: len = get16be(s); + if (len > MAXATOMLEN) return -1; memcpy(term->value.atom_name, s, len); term->value.atom_name[len] = '\0'; s += len; @@ -57,6 +58,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) /* first the nodename */ if (get8(s) != ERL_ATOM_EXT) return -1; len = get16be(s); + if (len > MAXATOMLEN) return -1; memcpy(term->value.ref.node, s, len); term->value.ref.node[len] = '\0'; s += len; @@ -71,6 +73,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) /* then the nodename */ if (get8(s) != ERL_ATOM_EXT) return -1; len = get16be(s); + if (len > MAXATOMLEN) return -1; memcpy(term->value.ref.node, s, len); term->value.ref.node[len] = '\0'; s += len; @@ -87,6 +90,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) case ERL_PORT_EXT: if (get8(s) != ERL_ATOM_EXT) return -1; len = get16be(s); + if (len > MAXATOMLEN) return -1; memcpy(term->value.port.node, s, len); term->value.port.node[len] = '\0'; term->value.port.id = get32be(s) & 0x0fffffff; /* 28 bits */; @@ -96,6 +100,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term) if (get8(s) != ERL_ATOM_EXT) return -1; /* name first */ len = get16be(s); + if (len > MAXATOMLEN) return -1; memcpy(term->value.pid.node, s, len); term->value.pid.node[len] = '\0'; s += len; diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl index fab00bbb9f..b9c4fa607c 100644 --- a/lib/kernel/src/inet6_tcp_dist.erl +++ b/lib/kernel/src/inet6_tcp_dist.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -162,8 +162,8 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> inet:getll(S) end, f_address = fun get_remote_id/2, - mf_tick = {?MODULE, tick}, - mf_getstat = {?MODULE,getstat} + mf_tick = fun ?MODULE:tick/1, + mf_getstat = fun ?MODULE:getstat/1 }, dist_util:handshake_other_started(HSData); {false,IP} -> diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 75a11a8afd..ce8c581e08 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -82,8 +82,9 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) -> end; _ -> case file:read_file_info(Name1) of - {ok, #file_info{mode=Mode}} when Mode band 8#111 =/= 0 -> - %% XXX This test for execution permission is not full-proof + {ok, #file_info{type=regular,mode=Mode}} + when Mode band 8#111 =/= 0 -> + %% XXX This test for execution permission is not fool-proof %% on Unix, since we test if any execution bit is set. {ok, Name1}; _ -> diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl index efce5bd476..9cccdab76b 100644 --- a/lib/kernel/test/erl_distribution_SUITE.erl +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -865,7 +865,7 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> % the node mercilessly. % We then want to ensure that the nodedown message arrives % last ... without garbage after it. - Pid = spawn(fun() -> node_loop_send(Me, NodeMsg, 1) end), + _ = spawn(fun() -> node_loop_send(Me, NodeMsg, 1) end), receive {Me, kill_it} -> ok end, halt() end), diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index ecb9a111f6..b08b12c978 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -175,6 +175,21 @@ find_executable(Config) when is_list(Config) -> ?line find_exe(Current, "my_batch", ".bat", Path), ok; {unix, _} -> + DataDir = ?config(data_dir, Config), + + %% Smoke test. + case lib:progname() of + erl -> + ?line ErlPath = os:find_executable("erl"), + ?line true = is_list(ErlPath), + ?line true = filelib:is_regular(ErlPath); + _ -> + %% Don't bother -- the progname could include options. + ok + end, + + %% Never return a directory name. + ?line false = os:find_executable("unix", [DataDir]), ok; vxworks -> ok diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl index b10aa76246..6c0fbc0618 100644 --- a/lib/ssl/src/inet_ssl_dist.erl +++ b/lib/ssl/src/inet_ssl_dist.erl @@ -1,8 +1,8 @@ -%%<copyright> -%% <year>2000-2008</year> -%% <holder>Ericsson AB, All Rights Reserved</holder> -%%</copyright> -%%<legalnotice> +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the @@ -14,8 +14,9 @@ %% the License for the specific language governing rights and limitations %% under the License. %% -%% The Initial Developer of the Original Code is Ericsson AB. -%%</legalnotice> +%% %CopyrightEnd% +%% + %% -module(inet_ssl_dist). @@ -137,7 +138,7 @@ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> %% Suppress dialyzer warning, we do not really care about old ssl code %% as we intend to remove it. --spec(do_accept/6 :: (_,_,_,_,_,_) -> no_return()). +-spec(do_accept(_,_,_,_,_,_) -> no_return()). do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> process_flag(priority, max), receive @@ -170,8 +171,8 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> ssl_prim:getll(S) end, f_address = fun get_remote_id/2, - mf_tick = {?MODULE, tick}, - mf_getstat = {?MODULE,getstat} + mf_tick = fun ?MODULE:tick/1, + mf_getstat = fun ?MODULE:getstat/1 }, dist_util:handshake_other_started(HSData); {false,IP} -> @@ -209,7 +210,7 @@ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> %% Suppress dialyzer warning, we do not really care about old ssl code %% as we intend to remove it. --spec(do_setup/6 :: (_,_,_,_,_,_) -> no_return()). +-spec(do_setup(_,_,_,_,_,_) -> no_return()). do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> process_flag(priority, max), ?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]), @@ -264,8 +265,8 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) -> protocol = ssl, family = inet} end, - mf_tick = {?MODULE, tick}, - mf_getstat = {?MODULE,getstat}, + mf_tick = fun ?MODULE:tick/1, + mf_getstat = fun ?MODULE:getstat/1, request_type = Type }, dist_util:handshake_we_started(HSData); diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 65b081937f..b85188b878 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -72,8 +72,8 @@ %%-------------------------------------------------------------------- --spec start() -> ok. --spec start(permanent | transient | temporary) -> ok. +-spec start() -> ok | {error, reason()}. +-spec start(permanent | transient | temporary) -> ok | {error, reason()}. %% %% Description: Utility function that starts the ssl, %% crypto and public_key applications. Default type diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 489895cf29..85245f4342 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1086,13 +1086,13 @@ init_private_key({rsa, PrivateKey}, _, _,_) -> init_private_key({dsa, PrivateKey},_,_,_) -> public_key:der_decode('DSAPrivateKey', PrivateKey). --spec(handle_file_error/6 :: (_,_,_,_,_,_) -> no_return()). +-spec(handle_file_error(_,_,_,_,_,_) -> no_return()). handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> file_error(Line, Error, Reason, File, Throw, Stack); handle_file_error(Line, Error, Reason, File, Throw, Stack) -> file_error(Line, Error, Reason, File, Throw, Stack). --spec(file_error/6 :: (_,_,_,_,_,_) -> no_return()). +-spec(file_error(_,_,_,_,_,_) -> no_return()). file_error(Line, Error, Reason, File, Throw, Stack) -> Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", [Line, Error, Reason, File, Stack]), @@ -1412,8 +1412,6 @@ key_exchange(#state{role = client, State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}. --spec(rsa_key_exchange/2 :: (_,_) -> no_return()). - rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) when Algorithm == ?rsaEncryption; Algorithm == ?md2WithRSAEncryption; diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index 7cb02afb11..0d2d23180a 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -31,7 +31,7 @@ %%----------------------------------------------------------------------- --type mode() :: 'compile' | 'debug' | 'interpret' | 'run'. +-type mode() :: 'native' | 'compile' | 'debug' | 'interpret' | 'run'. -type source() :: 'archive' | 'beam' | 'text'. -record(state, {file :: file:filename(), @@ -304,7 +304,11 @@ parse_and_run(File, Args, Options) -> false -> case lists:member("i", Options) of true -> interpret; - false -> Mode + false -> + case lists:member("n", Options) of + true -> native; + false -> Mode + end end end end, @@ -321,6 +325,14 @@ parse_and_run(File, Args, Options) -> _Other -> fatal("There were compilation errors.") end; + native -> + case compile:forms(FormsOrBin, [report,native]) of + {ok, Module, BeamBin} -> + {module, Module} = code:load_binary(Module, File, BeamBin), + run(Module, Args); + _Other -> + fatal("There were compilation errors.") + end; debug -> case compile:forms(FormsOrBin, [report, debug_info]) of {ok,Module,BeamBin} -> @@ -664,7 +676,7 @@ epp_parse_file2(Epp, S, Forms, Parsed) -> {attribute,Ln,mode,NewMode} -> S2 = S#state{mode = NewMode}, if - NewMode =:= compile; NewMode =:= interpret; NewMode =:= debug -> + NewMode =:= compile; NewMode =:= interpret; NewMode =:= debug; NewMode =:= native -> epp_parse_file(Epp, S2, [Form | Forms]); true -> Args = lists:flatten(io_lib:format("illegal mode attribute: ~p", [NewMode])), diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 7102fb9f6e..3c5800effa 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -40,7 +40,7 @@ %%-------------------------------------------------------------------------- -type child_id() :: pid() | 'undefined'. --type mfargs() :: {module(), atom(), [term()]}. +-type mfargs() :: {module(), atom(), [term()] | undefined}. -type modules() :: [module()] | 'dynamic'. -type restart() :: 'permanent' | 'transient' | 'temporary'. -type shutdown() :: 'brutal_kill' | timeout(). @@ -69,7 +69,7 @@ -record(state, {name, strategy :: strategy(), children = [] :: [child()], - dynamics = ?DICT:new() :: ?DICT(), + dynamics :: ?DICT() | list(), intensity :: non_neg_integer(), period :: pos_integer(), restarts = [], @@ -283,16 +283,15 @@ do_start_child_i(M, F, A) -> -spec handle_call(call(), term(), state()) -> {'reply', term(), state()}. handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> - #child{mfargs = {M, F, A}} = hd(State#state.children), + Child = hd(State#state.children), + #child{mfargs = {M, F, A}} = Child, Args = A ++ EArgs, case do_start_child_i(M, F, Args) of {ok, Pid} -> - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, + NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), {reply, {ok, Pid}, NState}; {ok, Pid, Extra} -> - NState = State#state{dynamics = - ?DICT:store(Pid, Args, State#state.dynamics)}, + NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State), {reply, {ok, Pid, Extra}, NState}; What -> {reply, What, State} @@ -351,10 +350,20 @@ handle_call({terminate_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -handle_call(which_children, _From, State) when ?is_simple(State) -> - [#child{child_type = CT, modules = Mods}] = State#state.children, +handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, + child_type = CT, + modules = Mods}]} = + State) when ?is_simple(State) -> + Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end, dynamics_db(temporary, + State#state.dynamics)), + {reply, Reply, State}; + +handle_call(which_children, _From, #state{children = [#child{restart_type = RType, + child_type = CT, + modules = Mods}]} = + State) when ?is_simple(State) -> Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end, - ?DICT:to_list(State#state.dynamics)), + ?DICT:to_list(dynamics_db(RType, State#state.dynamics))), {reply, Reply, State}; handle_call(which_children, _From, State) -> @@ -366,13 +375,31 @@ handle_call(which_children, _From, State) -> State#state.children), {reply, Resp, State}; -handle_call(count_children, _From, State) when ?is_simple(State) -> - [#child{child_type = CT}] = State#state.children, + +handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, + child_type = CT}]} = State) + when ?is_simple(State) -> + {Active, Count} = + lists:foldl(fun(Pid, {Alive, Tot}) -> + if is_pid(Pid) -> {Alive+1, Tot +1}; + true -> {Alive, Tot + 1} end + end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Reply = case CT of + supervisor -> [{specs, 1}, {active, Active}, + {supervisors, Count}, {workers, 0}]; + worker -> [{specs, 1}, {active, Active}, + {supervisors, 0}, {workers, Count}] + end, + {reply, Reply, State}; + +handle_call(count_children, _From, #state{children = [#child{restart_type = RType, + child_type = CT}]} = State) + when ?is_simple(State) -> {Active, Count} = ?DICT:fold(fun(Pid, _Val, {Alive, Tot}) -> if is_pid(Pid) -> {Alive+1, Tot +1}; true -> {Alive, Tot + 1} end - end, {0, 0}, State#state.dynamics), + end, {0, 0}, dynamics_db(RType, State#state.dynamics)), Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, {supervisors, Count}, {workers, 0}]; @@ -535,15 +562,11 @@ handle_start_child(Child, State) -> false -> case do_start_child(State#state.name, Child) of {ok, Pid} -> - Children = State#state.children, {{ok, Pid}, - State#state{children = - [Child#child{pid = Pid}|Children]}}; + save_child(Child#child{pid = Pid}, State)}; {ok, Pid, Extra} -> - Children = State#state.children, {{ok, Pid, Extra}, - State#state{children = - [Child#child{pid = Pid}|Children]}}; + save_child(Child#child{pid = Pid}, State)}; {error, What} -> {{error, {What, Child}}, State} end; @@ -558,22 +581,21 @@ handle_start_child(Child, State) -> %%% Returns: {ok, state()} | {shutdown, state()} %%% --------------------------------------------------- -restart_child(Pid, Reason, State) when ?is_simple(State) -> - case ?DICT:find(Pid, State#state.dynamics) of +restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) -> + RestartType = Child#child.restart_type, + case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of {ok, Args} -> - [Child] = State#state.children, - RestartType = Child#child.restart_type, {M, F, _} = Child#child.mfargs, NChild = Child#child{pid = Pid, mfargs = {M, F, Args}}, do_restart(RestartType, Reason, NChild, State); error -> - {ok, State} + {ok, State} end; + restart_child(Pid, Reason, State) -> Children = State#state.children, case lists:keyfind(Pid, #child.pid, Children) of - #child{} = Child -> - RestartType = Child#child.restart_type, + #child{restart_type = RestartType} = Child -> do_restart(RestartType, Reason, Child, State); false -> {ok, State} @@ -608,7 +630,8 @@ restart(Child, State) -> restart(simple_one_for_one, Child, State) -> #child{mfargs = {M, F, A}} = Child, - Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics), + Dynamics = ?DICT:erase(Child#child.pid, dynamics_db(Child#child.restart_type, + State#state.dynamics)), case do_start_child_i(M, F, A) of {ok, Pid} -> NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)}, @@ -755,8 +778,40 @@ monitor_child(Pid) -> %%----------------------------------------------------------------- %% Child/State manipulating functions. %%----------------------------------------------------------------- -state_del_child(#child{pid = Pid}, State) when ?is_simple(State) -> - NDynamics = ?DICT:erase(Pid, State#state.dynamics), + +%% Note we do not want to save the parameter list for temporary processes as +%% they will not be restarted, and hence we do not need this information. +%% Especially for dynamic children to simple_one_for_one supervisors +%% it could become very costly as it is not uncommon to spawn +%% very many such processes. +save_child(#child{restart_type = temporary, + mfargs = {M, F, _}} = Child, #state{children = Children} = State) -> + State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]}; +save_child(Child, #state{children = Children} = State) -> + State#state{children = [Child |Children]}. + +save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) -> + State#state{dynamics = [Pid | dynamics_db(temporary, Dynamics)]}; +save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) -> + State#state{dynamics = ?DICT:store(Pid, Args, dynamics_db(RestartType, Dynamics))}. + +dynamics_db(temporary, undefined) -> + []; +dynamics_db(_, undefined) -> + ?DICT:new(); +dynamics_db(_,Dynamics) -> + Dynamics. + +dynamic_child_args(_, Dynamics) when is_list(Dynamics)-> + {ok, undefined}; +dynamic_child_args(Pid, Dynamics) -> + ?DICT:find(Pid, Dynamics). + +state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) -> + NDynamics = lists:delete(Pid, dynamics_db(temporary, State#state.dynamics)), + State#state{dynamics = NDynamics}; +state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) -> + NDynamics = ?DICT:erase(Pid, dynamics_db(RType, State#state.dynamics)), State#state{dynamics = NDynamics}; state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 60fa429a3e..9d348b5f1a 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -348,8 +348,8 @@ t_match_spec_run_test(List, MS, Result) -> ms_tracer_collect(Tracee, Ref, Acc) -> receive - {trace, Tracee, call, Args, [Msg]} -> - %io:format("trace Args=~p Msg=~p\n", [Args, Msg]), + {trace, Tracee, call, _Args, [Msg]} -> + %io:format("trace Args=~p Msg=~p\n", [_Args, Msg]), ms_tracer_collect(Tracee, Ref, [Msg | Acc]); {'DOWN', Ref, process, Tracee, _} -> diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index f46493a2d8..0cca030b3d 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -75,7 +75,7 @@ app_test(suite) -> []; app_test(doc) -> ["Application consistency test."]; -app_test(Config) when list(Config) -> +app_test(Config) when is_list(Config) -> ?t:app_test(stdlib), ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 82643e105f..6e927da2ab 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -52,10 +52,12 @@ simple_one_for_one_extra/1]). %% Misc tests --export([child_unlink/1, tree/1, count_children_memory/1]). +-export([child_unlink/1, tree/1, count_children_memory/1, + do_not_save_start_parameters_for_temporary_children/1]). %------------------------------------------------------------------------- + suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> @@ -67,7 +69,7 @@ all() -> {group, restart_rest_for_one}, {group, normal_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children_memory]. + count_children_memory, do_not_save_start_parameters_for_temporary_children]. groups() -> [{sup_start, [], @@ -117,7 +119,6 @@ init_per_testcase(_Case, Config) -> end_per_testcase(_Case, _Config) -> ok. - start(InitResult) -> supervisor:start_link({local, sup_test}, ?MODULE, InitResult). @@ -135,14 +136,8 @@ get_child_counts(Supervisor) -> proplists:get_value(supervisors, Counts), proplists:get_value(workers, Counts)]. - %------------------------------------------------------------------------- -% % Test cases starts here. -% -%------------------------------------------------------------------------- - - %------------------------------------------------------------------------- sup_start_normal(doc) -> ["Tests that the supervisor process starts correctly and that it " @@ -242,8 +237,6 @@ sup_start_fail(Config) when is_list(Config) -> ok. %------------------------------------------------------------------------- -%------------------------------------------------------------------------- - sup_stop_infinity(doc) -> ["See sup_stop/1 when Shutdown = infinity, this walue is only allowed " "for children of type supervisor"]; @@ -594,7 +587,6 @@ child_specs(Config) when is_list(Config) -> ?line ok = supervisor:check_childspecs([C3]), ?line ok = supervisor:check_childspecs([C4]), ok. -%------------------------------------------------------------------------- %------------------------------------------------------------------------- permanent_normal(doc) -> @@ -656,7 +648,6 @@ temporary_normal(Config) when is_list(Config) -> ?line [1,0,0,1] = get_child_counts(sup_test), ok. -%------------------------------------------------------------------------- %------------------------------------------------------------------------- permanent_abnormal(doc) -> @@ -725,8 +716,6 @@ temporary_abnormal(Config) when is_list(Config) -> ok. %------------------------------------------------------------------------- - -%------------------------------------------------------------------------- one_for_one(doc) -> ["Test the one_for_one base case."]; one_for_one(suite) -> []; @@ -805,8 +794,6 @@ one_for_one_escalation(Config) when is_list(Config) -> end, ok. %------------------------------------------------------------------------- - -%------------------------------------------------------------------------- one_for_all(doc) -> ["Test the one_for_all base case."]; one_for_all(suite) -> []; @@ -894,8 +881,6 @@ one_for_all_escalation(Config) when is_list(Config) -> ok. %------------------------------------------------------------------------- - -%------------------------------------------------------------------------- simple_one_for_one(doc) -> ["Test the simple_one_for_one base case."]; simple_one_for_one(suite) -> []; @@ -1012,8 +997,6 @@ simple_one_for_one_escalation(Config) when is_list(Config) -> end, ok. %------------------------------------------------------------------------- - -%------------------------------------------------------------------------- rest_for_one(doc) -> ["Test the rest_for_one base case."]; rest_for_one(suite) -> []; @@ -1287,7 +1270,9 @@ tree(Config) when is_list(Config) -> ok. %------------------------------------------------------------------------- count_children_memory(doc) -> - ["Test that which_children eats memory, but count_children does not."]; + ["Test that count_children does not eat memory."]; +count_children_memory(suite) -> + []; count_children_memory(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, temporary, 1000, @@ -1300,7 +1285,7 @@ count_children_memory(Config) when is_list(Config) -> Children = supervisor:which_children(sup_test), _Size2 = erlang:memory(processes_used), ChildCount = get_child_counts(sup_test), - Size3 = erlang:memory(processes_used), + _Size3 = erlang:memory(processes_used), [supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)], @@ -1324,8 +1309,8 @@ count_children_memory(Config) when is_list(Config) -> ?line ChildCount3 = ChildCount2, %% count_children consumes memory using an accumulator function, - %% but the space can be reclaimed incrementally, whereas - %% which_children generates a return list. + %% but the space can be reclaimed incrementally, + %% which_children may generate garbage that will be reclaimed later. case (Size5 =< Size4) of true -> ok; false -> @@ -1337,23 +1322,10 @@ count_children_memory(Config) when is_list(Config) -> ?line test_server:fail({count_children, used_more_memory}) end, - case Size4 > Size3 of - true -> ok; - false -> - ?line test_server:fail({which_children, used_no_memory}) - end, - case Size6 > Size5 of - true -> ok; - false -> - ?line test_server:fail({which_children, used_no_memory}) - end, - [exit(Pid, kill) || {undefined, Pid, worker, _Modules} <- Children3], test_server:sleep(100), ?line [1,0,0,0] = get_child_counts(sup_test), - ok. - count_children_allocator_test(MemoryState) -> Allocators = [temp_alloc, eheap_alloc, binary_alloc, ets_alloc, driver_alloc, sl_alloc, ll_alloc, fix_alloc, std_alloc, @@ -1364,3 +1336,84 @@ count_children_allocator_test(MemoryState) -> AllocStates = [lists:keyfind(e, 1, AllocValue) || {_Type, AllocValue} <- AllocTypes], lists:all(fun(State) -> State == {e, true} end, AllocStates). +%------------------------------------------------------------------------- +do_not_save_start_parameters_for_temporary_children(doc) -> + ["Temporary children shall not be restarted so they should not " + "save start parameters, as it potentially can " + "take up a huge amount of memory for no purpose."]; +do_not_save_start_parameters_for_temporary_children(suite) -> + []; +do_not_save_start_parameters_for_temporary_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + dont_save_start_parameters_for_temporary_children(one_for_all), + dont_save_start_parameters_for_temporary_children(one_for_one), + dont_save_start_parameters_for_temporary_children(rest_for_one), + dont_save_start_parameters_for_temporary_children(simple_one_for_one). + +dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) -> + Permanent = {child, {supervisor_1, start_child, []}, + permanent, 1000, worker, []}, + Transient = {child, {supervisor_1, start_child, []}, + transient, 1000, worker, []}, + Temporary = {child, {supervisor_1, start_child, []}, + temporary, 1000, worker, []}, + {ok, Sup1} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Permanent]}}), + {ok, Sup2} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Transient]}}), + {ok, Sup3} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Temporary]}}), + + LargeList = lists:duplicate(10, "Potentially large"), + + start_children(Sup1, [LargeList], 100), + start_children(Sup2, [LargeList], 100), + start_children(Sup3, [LargeList], 100), + + [{memory,Mem1}] = process_info(Sup1, [memory]), + [{memory,Mem2}] = process_info(Sup2, [memory]), + [{memory,Mem3}] = process_info(Sup3, [memory]), + + true = (Mem3 < Mem1) and (Mem3 < Mem2), + + exit(Sup1, shutdown), + exit(Sup2, shutdown), + exit(Sup3, shutdown); + +dont_save_start_parameters_for_temporary_children(Type) -> + {ok, Sup1} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}), + {ok, Sup2} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}), + {ok, Sup3} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}), + + LargeList = lists:duplicate(10, "Potentially large"), + + Permanent = {child1, {supervisor_1, start_child, [LargeList]}, + permanent, 1000, worker, []}, + Transient = {child2, {supervisor_1, start_child, [LargeList]}, + transient, 1000, worker, []}, + Temporary = {child3, {supervisor_1, start_child, [LargeList]}, + temporary, 1000, worker, []}, + + start_children(Sup1, Permanent, 100), + start_children(Sup2, Transient, 100), + start_children(Sup3, Temporary, 100), + + [{memory,Mem1}] = process_info(Sup1, [memory]), + [{memory,Mem2}] = process_info(Sup2, [memory]), + [{memory,Mem3}] = process_info(Sup3, [memory]), + + true = (Mem3 < Mem1) and (Mem3 < Mem2), + + exit(Sup1, shutdown), + exit(Sup2, shutdown), + exit(Sup3, shutdown). + +start_children(_,_, 0) -> + ok; +start_children(Sup, Args, N) -> + Spec = child_spec(Args, N), + {ok, _, _} = supervisor:start_child(Sup, Spec), + start_children(Sup, Args, N-1). + +child_spec([_|_] = SimpleOneForOneArgs, _) -> + SimpleOneForOneArgs; +child_spec({Name, MFA, RestartType, Shutdown, Type, Modules}, N) -> + NewName = list_to_atom((atom_to_list(Name) ++ integer_to_list(N))), + {NewName, MFA, RestartType, Shutdown, Type, Modules}. diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index e0bf50bc43..2ab4e9c28a 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -470,7 +470,7 @@ cover_analyse(Analyse,Modules) -> overview -> fun(_) -> undefined end end, - R = lists:map( + R = pmap( fun(M) -> case cover:analyse(M,module) of {ok,{M,{Cov,NotCov}}} -> @@ -486,6 +486,19 @@ cover_analyse(Analyse,Modules) -> stick_all_sticky(node(),Sticky), R. +pmap(Fun,List) -> + Collector = self(), + Pids = lists:map(fun(E) -> + spawn(fun() -> + Collector ! {res,self(),Fun(E)} + end) + end, List), + lists:map(fun(Pid) -> + receive + {res,Pid,Res} -> + Res + end + end, Pids). unstick_all_sticky(Node) -> lists:filter( diff --git a/lib/test_server/src/ts_install_cth.erl b/lib/test_server/src/ts_install_cth.erl index 3e28ebd529..f8b4e5a4f8 100644 --- a/lib/test_server/src/ts_install_cth.erl +++ b/lib/test_server/src/ts_install_cth.erl @@ -68,7 +68,6 @@ id(_Opts) -> -spec init(Id :: term(), Opts :: proplist()) -> State :: #state{}. init(_Id, Opts) -> -% ct:log("CurrWD: ~p",[file:get_cwd()]), Nodenames = proplists:get_value(nodenames, Opts, 0), Nodes = proplists:get_value(nodes, Opts, 0), TSConfDir = proplists:get_value(ts_conf_dir, Opts), @@ -93,13 +92,8 @@ pre_init_per_suite(Suite,Config,#state{ ts_conf_dir = undefined} = State) -> TSConfDir = filename:join([ParentDir, "..","test_server"]), pre_init_per_suite(Suite, Config, State#state{ ts_conf_dir = TSConfDir }); pre_init_per_suite(_Suite,Config,State) -> -% ct:log("pre_init_per_suite(~p,~p,~p)",[_Suite,Config,State]), DataDir = proplists:get_value(data_dir, Config), try -% install(State#state.ts_conf_dir, -% State#state.target_system, -% State#state.install_opts), - {ok,Variables} = file:consult(filename:join(State#state.ts_conf_dir,"variables")), @@ -221,7 +215,6 @@ on_tc_skip(_TC, _Reason, State) -> -spec terminate(State :: #state{}) -> term(). terminate(_State) -> -% ct:log("Terminate called"), ok. %%% ============================================================================ diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 60e01600e1..d572b1454c 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -28,7 +28,7 @@ -include("ts.hrl"). --import(lists, [map/2,member/2,filter/2,reverse/1]). +-import(lists, [member/2,filter/2]). -record(state, {file, % File given. @@ -75,19 +75,6 @@ run(File, Args0, Options, Vars0) -> Error -> Error end. -make_loop(Hooks, Vars0, Spec0, St0) -> - case St0#state.makefiles of - [Makefile|Rest] -> - case execute(Hooks, Vars0, Spec0, St0#state{makefile=Makefile}) of - {error, Reason} -> - {error, Reason}; - {ok, Vars, Spec, St} -> - make_loop(Hooks, Vars, Spec, St#state{makefiles=Rest}) - end; - [] -> - {ok, Vars0, Spec0, St0} - end. - execute([Hook|Rest], Vars0, Spec0, St0) -> case Hook(Vars0, Spec0, St0) of ok -> @@ -137,101 +124,6 @@ init_state(Vars, [], St0) -> false -> {error,{no_test_directory,TestDir}} end. - -%% Read the spec file for the test suite. - -read_spec_file(Vars, _, St) -> - TestDir = St#state.test_dir, - File = St#state.file, - {SpecFile,Res} = get_spec_filename(Vars, TestDir, File), - case Res of - {ok,Spec} -> - {ok,Vars,Spec,St}; - {error,Atom} when is_atom(Atom) -> - {error,{no_spec,SpecFile}}; - {error,Reason} -> - {error,{bad_spec,lists:flatten(file:format_error(Reason))}} - end. - -get_spec_filename(Vars, TestDir, File) -> - DynSpec = filename:join(TestDir, File ++ ".dynspec"), - case filelib:is_file(DynSpec) of - true -> - Bs0 = erl_eval:new_bindings(), - Bs1 = erl_eval:add_binding('Target', ts_lib:var(target, Vars), Bs0), - Bs2 = erl_eval:add_binding('Os', ts_lib:var(os, Vars), Bs1), - TCCStr = ts_lib:var(test_c_compiler, Vars), - TCC = try - {ok, Toks, _} = erl_scan:string(TCCStr ++ "."), - {ok, Tcc} = erl_parse:parse_term(Toks), - Tcc - catch - _:_ -> undefined - end, - Bs = erl_eval:add_binding('TestCCompiler', TCC, Bs2), - {DynSpec,file:script(DynSpec, Bs)}; - false -> - SpecFile = get_spec_filename_1(Vars, TestDir, File), - {SpecFile,file:consult(SpecFile)} - end. - -get_spec_filename_1(Vars, TestDir, File) -> - case ts_lib:var(os, Vars) of - "VxWorks" -> - check_spec_filename(TestDir, File, ".spec.vxworks"); - "Windows"++_ -> - check_spec_filename(TestDir, File, ".spec.win"); - _Other -> - filename:join(TestDir, File ++ ".spec") - end. - -check_spec_filename(TestDir, File, Ext) -> - Spec = filename:join(TestDir, File ++ Ext), - case filelib:is_file(Spec) of - true -> Spec; - false -> filename:join(TestDir, File ++ ".spec") - end. - -%% Remove the top case from the spec file. We will add our own -%% top case later. - -remove_original_topcase(Vars, Spec, St) -> - {ok,Vars,filter(fun ({topcase,_}) -> false; - (_Other) -> true end, Spec),St}. - -%% Initialize our new top case. We'll keep in it the state to be -%% able to add more to it. - -init_topcase(Vars, Spec, St) -> - TestDir = St#state.test_dir, - TopCase = - case St#state.mod of - Mod when is_atom(Mod) -> - ModStr = atom_to_list(Mod), - case filelib:is_file(filename:join(TestDir,ModStr++".erl")) of - true -> [{Mod,all}]; - false -> - Wc = filename:join(TestDir, ModStr ++ "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end; - _Other -> - %% Here we used to return {dir,TestDir}. Now we instead - %% list all suites in TestDir, so we can add make testcases - %% around it later (see add_make_testcase) without getting - %% duplicates of the suite. (test_server_ctrl does no longer - %% check for duplicates of testcases) - Wc = filename:join(TestDir, "*_SUITE.erl"), - [{list_to_atom(filename:basename(M, ".erl")),all} || - M <- filelib:wildcard(Wc)] - end, - {ok,Vars,Spec,St#state{topcase=TopCase}}. - -%% Or if option keep_topcase was given, eh... keep the topcase -copy_topcase(Vars, Spec, St) -> - {value,{topcase,Tc}} = lists:keysearch(topcase,1,Spec), - {ok, Vars, lists:keydelete(topcase,1,Spec),St#state{topcase=Tc}}. - %% Run any "Makefile.first" files first. %% XXX We should fake a failing test case if the make fails. @@ -260,157 +152,6 @@ run_pre_makefile(Vars, Spec, St) -> {error,_Reason}=Error -> Error end. -%% Search for `Makefile.src' in each *_SUITE_data directory. - -find_makefiles(Vars, Spec, St) -> - Wc = filename:join(St#state.data_wc, "Makefile.src"), - Makefiles = reverse(del_skipped_suite_data_dir(filelib:wildcard(Wc), Spec)), - {ok,Vars,Spec,St#state{makefiles=Makefiles}}. - -%% Create "Makefile" from "Makefile.src". - -make_make(Vars, Spec, State) -> - Src = State#state.makefile, - Dest = filename:rootname(Src), - ts_lib:progress(Vars, 1, "Making ~s...\n", [Dest]), - case ts_lib:subst_file(Src, Dest, Vars) of - ok -> - {ok, Vars, Spec, State#state{makefile=Dest}}; - {error, Reason} -> - {error, {Src, Reason}} - end. - -%% Add a testcase which will do the making of the stuff in the data directory. - -add_make_testcase(Vars, Spec, St) -> - Makefile = St#state.makefile, - Dir = filename:dirname(Makefile), - Shortname = filename:basename(Makefile), - Suite = filename:basename(Dir, "_data"), - Config = [{data_dir,Dir},{makefile,Shortname}], - MakeModule = Suite ++ "_make", - MakeModuleSrc = filename:join(filename:dirname(Dir), - MakeModule ++ ".erl"), - MakeMod = list_to_atom(MakeModule), - case filelib:is_file(MakeModuleSrc) of - true -> ok; - false -> generate_make_module(ts_lib:var(make_command, Vars), - MakeModuleSrc, - MakeModule) - end, - case Suite of - "all_SUITE" -> - {ok,Vars,Spec,St#state{all={MakeMod,Config}}}; - _ -> - %% Avoid duplicates of testcases. There is no longer - %% a check for this in test_server_ctrl. - TestCase = {list_to_atom(Suite),all}, - TopCase0 = case St#state.topcase of - List when is_list(List) -> - List -- [TestCase]; - Top -> - [Top] -- [TestCase] - end, - TopCase = [{make,{MakeMod,make,[Config]}, - TestCase, - {MakeMod,unmake,[Config]}}|TopCase0], - {ok,Vars,Spec,St#state{topcase=TopCase}} - end. - -generate_make_module(MakeCmd, Name, ModuleString) -> - {ok,Host} = inet:gethostname(), - file:write_file(Name, - ["-module(",ModuleString,").\n", - "\n", - "-export([make/1,unmake/1]).\n", - "\n", - "make(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_MAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:make([{make_command, \""++MakeCmd++"\"},{cross_node,\'ts@" ++ Host ++ "\'}|Config]),\n", - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n", - "unmake(Config) when is_list(Config) ->\n", - " Mins = " ++ integer_to_list(?DEFAULT_UNMAKE_TIMETRAP_MINUTES) ++ ",\n" - " test_server:format(\"=== Setting timetrap to ~p minutes ===~n\", [Mins]),\n" - " TimeTrap = test_server:timetrap(test_server:minutes(Mins)),\n" - " Res = ts_make:unmake([{make_command, \""++MakeCmd++"\"}|Config]),\n" - " test_server:timetrap_cancel(TimeTrap),\n" - " Res.\n" - "\n"]). - - -make_test_suite(Vars, _Spec, State) -> - TestDir = State#state.test_dir, - - Erl_flags=[{i, "../test_server"}|ts_lib:var(erl_flags,Vars)], - - case code:is_loaded(test_server_line) of - false -> code:load_file(test_server_line); - _ -> ok - end, - - {ok, Cwd} = file:get_cwd(), - ok = file:set_cwd(TestDir), - Result = (catch make_all(Erl_flags)), - ok = file:set_cwd(Cwd), - case Result of - up_to_date -> - ok; - {'EXIT', Reason} -> - %% If I return an error here, the test will be stopped - %% and it will not show up in the top index page. Instead - %% I return ok - the test will run for all existing suites. - %% It might be that there are old suites that are run, but - %% at least one suite is missing, and that is reported on the - %% top index page. - io:format("~s: {error,{make_crashed,~p}\n", - [State#state.file,Reason]), - ok; - error -> - %% See comment above - io:format("~s: {error,make_of_test_suite_failed}\n", - [State#state.file]), - ok - end. - -%% Add topcase to spec. - -add_topcase_to_spec(Vars, Spec, St) -> - Tc = case St#state.all of - {MakeMod,Config} -> - [{make,{MakeMod,make,[Config]}, - St#state.topcase, - {MakeMod,unmake,[Config]}}]; - undefined -> St#state.topcase - end, - {ok,Vars,Spec++[{topcase,Tc}],St}. - -%% Writes the (possibly transformed) spec file. - -write_spec_file(Vars, Spec, _State) -> - F = fun(Term) -> io_lib:format("~p.~n", [Term]) end, - SpecFile = map(F, Spec), - Hosts = - case lists:keysearch(hosts, 1, Vars) of - false -> - []; - {value, {hosts, HostList}} -> - io_lib:format("{hosts,~p}.~n",[HostList]) - end, - DiskLess = - case lists:keysearch(diskless, 1, Vars) of - false -> - []; - {value, {diskless, How}} -> - io_lib:format("{diskless, ~p}.~n",[How]) - end, - Conf = consult_config(), - MoreConfig = io_lib:format("~p.\n", [{config,Conf}]), - file:write_file("current.spec", [DiskLess,Hosts,MoreConfig,SpecFile]). - get_config_files() -> TSConfig = "ts.config", [TSConfig | case os:type() of @@ -420,21 +161,6 @@ get_config_files() -> _ -> [] end]. -consult_config() -> - {ok,Conf} = file:consult("ts.config"), - case os:type() of - {unix,_} -> consult_config("ts.unix.config", Conf); - {win32,_} -> consult_config("ts.win32.config", Conf); - vxworks -> consult_config("ts.vxworks.config", Conf); - _ -> Conf - end. - -consult_config(File, Conf0) -> - case file:consult(File) of - {ok,Conf} -> Conf++Conf0; - {error,enoent} -> Conf0 - end. - %% Makes the command to start up the Erlang node to run the tests. backslashify([$\\, $" | T]) -> @@ -647,77 +373,11 @@ make_common_test_args(Args0, Options, _Vars) -> io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ ConfigFiles++Options]). -make_test_server_args(Args0,Options,Vars) -> - Parameters = - case ts_lib:var(os, Vars) of - "VxWorks" -> - F = write_parameterfile(vxworks,Vars), - " PARAMETERS " ++ F; - _ -> - "" - end, - Trace = - case lists:keysearch(trace,1,Options) of - {value,{trace,TI}} when is_tuple(TI); is_tuple(hd(TI)) -> - ok = file:write_file(?tracefile,io_lib:format("~p.~n",[TI])), - " TRACE " ++ ?tracefile; - {value,{trace,TIFile}} when is_atom(TIFile) -> - " TRACE " ++ atom_to_list(TIFile); - {value,{trace,TIFile}} -> - " TRACE " ++ TIFile; - false -> - "" - end, - Cover = - case lists:keysearch(cover,1,Options) of - {value,{cover,App,File,Analyse}} -> - " COVER " ++ to_list(App) ++ " " ++ to_list(File) ++ " " ++ - to_list(Analyse); - false -> - "" - end, - TCCallback = - case ts_lib:var(ts_testcase_callback, Vars) of - "" -> - ""; - {Mod,Func} -> - io:format("Function ~w:~w/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ to_list(Mod) ++ " " ++ to_list(Func); - ModFunc when is_list(ModFunc) -> - [Mod,Func]=string:tokens(ModFunc," "), - io:format("Function ~s:~s/4 will be called before and " - "after each test case.\n", [Mod,Func]), - " TESTCASE_CALLBACK " ++ ModFunc; - _ -> - "" - end, - Args0 ++ Parameters ++ Trace ++ Cover ++ TCCallback. - to_list(X) when is_atom(X) -> atom_to_list(X); to_list(X) when is_list(X) -> X. -write_parameterfile(Type,Vars) -> - Cross_host = ts_lib:var(target_host, Vars), - SlaveTargets = case lists:keysearch(slavetargets,1,Vars) of - {value, ST} -> - [ST]; - _ -> - [] - end, - Master = case lists:keysearch(master,1,Vars) of - {value,M} -> [M]; - false -> [] - end, - ToWrite = [{type,Type}, - {target, list_to_atom(Cross_host)}] ++ SlaveTargets ++ Master, - - Crossfile = atom_to_list(Type) ++ "parameters" ++ os:getpid(), - ok = file:write_file(Crossfile,io_lib:format("~p.~n", [ToWrite])), - Crossfile. - %% %% Paths and spaces handling for w2k and XP %% @@ -763,53 +423,3 @@ split_one(Path) -> split_path(Path) -> string:tokens(Path,";"). - -%% -%% Run make:all/1 if the test suite seems to be designed -%% to be built/re-built by ts. -%% -make_all(Flags) -> - case filelib:is_regular("Emakefile") of - false -> - make_all_no_emakefile(Flags); - true -> - make:all(Flags) - end. - -make_all_no_emakefile(Flags) -> - case filelib:wildcard("*.beam") of - [] -> - %% Since there are no *.beam files, we will assume - %% that this test suite was designed to be built and - %% re-built by ts. Create an Emakefile so that - %% make:all/1 will be run the next time too - %% (in case a test suite is being interactively - %% developed). - create_emakefile(Flags, "*.erl"); - [_|_] -> - %% There is no Emakefile and there already are - %% some *.beam files here. Assume that this test - %% suite was not designed to be re-built by ts. - %% Only create a Emakefile that will compile - %% generated *_SUITE_make files (if any). - create_emakefile(Flags, "*_SUITE_make.erl") - end. - -create_emakefile(Flags, Wc) -> - case filelib:wildcard(Wc) of - [] -> - %% There are no files to be built (i.e. not even any - %% generated *_SUITE_make.erl files). We must handle - %% this case specially, because make:all/1 will crash - %% on Emakefile with an empty list of modules. - io:put_chars("No Emakefile found - not running make:all/1\n"), - up_to_date; - [_|_]=Ms0 -> - io:format("Creating an Emakefile for compiling files matching ~s\n", - [Wc]), - Ms = [list_to_atom(filename:rootname(M, ".erl")) || M <- Ms0], - Make0 = {Ms,Flags}, - Make = io_lib:format("~p. \n", [Make0]), - ok = file:write_file("Emakefile", Make), - make:all(Flags) - end. diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index 9fe5aee3bb..0648c1f96a 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -27,11 +27,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES= \ test_server_SUITE \ test_server_line_SUITE \ - test_server_skip_SUITE \ - test_server_conf01_SUITE \ - test_server_conf02_SUITE \ - test_server_parallel01_SUITE \ - test_server_shuffle01_SUITE + test_server_test_lib ERL_FILES= $(MODULES:%=%.erl) @@ -52,6 +48,7 @@ RELSYSDIR = $(RELEASE_PATH)/test_server_test ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test EBIN = . diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec index 23b0b71963..a3b4d01d08 100644 --- a/lib/test_server/test/test_server.spec +++ b/lib/test_server/test/test_server.spec @@ -1,2 +1 @@ -{topcase, {dir, "../test_server_test"}}. -{skip,{test_server_SUITE,skip_case7,"This case should be noted as `Skipped'"}}. +{suites, "../test_server_test", all}. diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl index 0563e1104f..f4c19eeaf9 100644 --- a/lib/test_server/test/test_server_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -16,539 +16,149 @@ %% %% %CopyrightEnd% %% - -%%%------------------------------------------------------------------ -%%% Test Server self test. -%%%------------------------------------------------------------------ +%%%------------------------------------------------------------------- +%%% @author Lukas Larsson <[email protected]> +%%% @copyright (C) 2011, Erlang Solutions Ltd. +%%% @doc +%%% +%%% @end +%%% Created : 15 Feb 2011 by Lukas Larsson <[email protected]> +%%%------------------------------------------------------------------- -module(test_server_SUITE). --include_lib("test_server/include/test_server.hrl"). --include_lib("test_server/include/test_server_line.hrl"). --include_lib("kernel/include/file.hrl"). --export([all/1]). --export([init_per_suite/1, end_per_suite/1]). --export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). --export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, - init_per_s/1, init_per_tc/1, end_per_tc/1, - timeconv/1, msgs/1, capture/1, timecall/1, - do_times/1, do_times_mfa/1, do_times_fun/1, - skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, - skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, - skip_case8/1, skip_case9/1, undefined_functions/1, - conf_init/1, check_new_conf/1, conf_cleanup/1, - check_old_conf/1, conf_init_fail/1, start_stop_node/1, - cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, - commercial/1]). +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include("test_server_test_lib.hrl"). --export([dummy_function/0,dummy_function/1,doer/1]). +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- -all(doc) -> ["Test Server self test"]; -all(suite) -> - [config, comment, timetrap, timetrap_cancel, multiply_timetrap, - init_per_s, init_per_tc, end_per_tc, - timeconv, msgs, capture, timecall, do_times, skip_cases, - undefined_functions, commercial, - {conf, conf_init, [check_new_conf], conf_cleanup}, - check_old_conf, - {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, - start_stop_node, - {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, - config - ]. +%% @spec suite() -> Info +suite() -> + [{ct_hooks,[ts_install_cth,test_server_test_lib]}]. +%% @spec init_per_suite(Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} init_per_suite(Config) -> - [{init_per_suite_var,ok}|Config]. + [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config]. +%% @spec end_per_suite(Config) -> _ end_per_suite(_Config) -> - ok. - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(2)), - Config1 = [{watchdog, Dog}|Config], - case Func of - init_per_tc -> - [{strange_var, 1}|Config1]; - skip_case8 -> - {skipped, "This case should be noted as `Skipped'"}; - skip_case9 -> - {skip, "This case should be noted as `Skipped'"}; - _ -> - Config1 - end; -init_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to init_per_testcase not correct"). - -end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog=?config(watchdog, Config), - ?t:timetrap_cancel(Dog), - case Func of - end_per_tc -> io:format("CLEANUP => this test case is ok\n"); - _Other -> ok - end; -end_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("Arguments to end_per_testcase not correct"). - -fin_per_testcase(Func, Config) -> - io:format("Func:~p",[Func]), - io:format("Config:~p",[Config]), - ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]), + ok. + +%% @spec init_per_group(GroupName, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_group(_GroupName, Config) -> + Config. + +%% @spec end_per_group(GroupName, Config0) -> +%% void() | {save_config,Config1} +end_per_group(_GroupName, _Config) -> + ok. + +%% @spec init_per_testcase(TestCase, Config0) -> +%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1} +init_per_testcase(_TestCase, Config) -> + Config. + +%% @spec end_per_testcase(TestCase, Config0) -> +%% void() | {save_config,Config1} | {fail,Reason} +end_per_testcase(_TestCase, _Config) -> + ok. + +%% @spec: groups() -> [Group] +groups() -> + []. + +%% @spec all() -> GroupsAndTestCases | {skip,Reason} +all() -> + [test_server_SUITE, test_server_parallel01_SUITE, + test_server_conf02_SUITE, test_server_conf01_SUITE, + test_server_skip_SUITE, test_server_shuffle01_SUITE]. + + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- +%% @spec TestCase(Config0) -> +%% ok | exit() | {skip,Reason} | {comment,Comment} | +%% {save_config,Config1} | {skip_and_save,Reason,Config1} +test_server_SUITE(Config) -> +% rpc:call(Node,dbg, tracer,[]), +% rpc:call(Node,dbg, p,[all,c]), +% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]), + run_test_server_tests("test_server_SUITE", 39, 1, 31, + 20, 9, 1, 11, 2, 26, Config). + +test_server_parallel01_SUITE(Config) -> + run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19, + 19, 0, 0, 0, 0, 37, Config). + +test_server_shuffle01_SUITE(Config) -> + run_test_server_tests("test_server_shuffle01_SUITE", 130, 0, 0, + 76, 0, 0, 0, 0, 130, Config). + +test_server_skip_SUITE(Config) -> + run_test_server_tests("test_server_skip_SUITE", 3, 0, 1, + 0, 0, 1, 3, 0, 0, Config). + +test_server_conf01_SUITE(Config) -> + run_test_server_tests("test_server_conf01_SUITE", 24, 0, 12, + 12, 0, 0, 0, 0, 24, Config). + +test_server_conf02_SUITE(Config) -> + run_test_server_tests("test_server_conf02_SUITE", 26, 0, 12, + 12, 0, 0, 0, 0, 26, Config). + + +run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc, + NUsrSkip, NAutoSkip, + NActualSkip, NActualFail, NActualSucc, Config) -> + Node = proplists:get_value(node, Config), + {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []), + rpc:call(Node, + test_server_ctrl,add_dir_with_skip, + [SuiteName, + [proplists:get_value(data_dir,Config)],SuiteName, + [{test_server_SUITE,skip_case7,"SKIPPED!"}]]), + + until(fun() -> + rpc:call(Node,test_server_ctrl,jobs,[]) =:= [] + end), - -config(suite) -> []; -config(doc) -> ["Test that the Config variable is decent, ", - "and that the std config variables are correct ", - "(check that data/priv dir exists)." - "Also check that ?config macro works."]; -config(Config) when is_list(Config) -> - is_tuplelist(Config), - {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), - true=is_dir(Dd), - {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), - true=is_dir(Dp), - - Dd = ?config(data_dir,Config), - Dp = ?config(priv_dir,Config), - ok; -config(_Config) -> - ?t:fail("Config variable is not a list."). - -is_tuplelist([]) -> - true; -is_tuplelist([{_A,_B}|Rest]) -> - is_tuplelist(Rest); -is_tuplelist(_) -> - false. - -is_dir(Dir) -> - case file:read_file_info(Dir) of - {ok, #file_info{type=directory}} -> - true; - _ -> - false - end. - -comment(suite) -> []; -comment(doc) -> ["Print a comment in the HTML log"]; -comment(Config) when is_list(Config) -> - ?t:comment("This comment should not occur in the HTML log because a later" - " comment shall overwrite it"), - ?t:comment("This comment is printed with the comment/1 function." - " It should occur in the HTML log"). - - - -timetrap(suite) -> []; -timetrap(doc) -> ["Test that timetrap works."]; -timetrap(Config) when is_list(Config) -> - TrapAfter = 3000, - Dog=?t:timetrap(TrapAfter), - process_flag(trap_exit, true), - TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, - receive - {'EXIT', Dog, {timetrap_timeout, _, _}} -> - ok; - {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> - ?t:fail("EXIT signal from wrong process") - after - TimeOut -> - ?t:fail("Timetrap is not working.") - end, - ?t:timetrap_cancel(Dog), - ok. - - -timetrap_cancel(suite) -> []; -timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; -timetrap_cancel(Config) when is_list(Config) -> - Dog=?t:timetrap(1000), - receive - after - 500 -> - ok - end, - ?t:timetrap_cancel(Dog), - receive - after 1000 -> - ok - end, - ok. - -multiply_timetrap(suite) -> []; -multiply_timetrap(doc) -> ["Test multiply timetrap"]; -multiply_timetrap(Config) when is_list(Config) -> - %% This simulates the call to test_server_ctrl:multiply_timetraps/1: - put(test_server_multiply_timetraps,{2,true}), - - Dog = ?t:timetrap(500), - timer:sleep(800), - ?t:timetrap_cancel(Dog), - - %% Reset - put(test_server_multiply_timetraps,1), - ok. - - -init_per_s(suite) -> []; -init_per_s(doc) -> ["Test that a Config that is altered in ", - "init_per_suite gets through to the testcases."]; -init_per_s(Config) -> - %% Check that the config var sent from init_per_suite - %% really exists. - {value, {init_per_suite_var, ok}} = - lists:keysearch(init_per_suite_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -init_per_tc(suite) -> []; -init_per_tc(doc) -> ["Test that a Config that is altered in ", - "init_per_testcase gets through to the ", - "actual testcase."]; -init_per_tc(Config) -> - %% Check that the config var sent from init_per_testcase - %% really exists. - {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), - - %% Check that the other variables still exist. - {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), - {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), - ok. - -end_per_tc(suite) -> []; -end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" - " test case fails"]; -end_per_tc(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that \"CLEANUP\" is" - " printed in the minor log file."). - - -timeconv(suite) -> []; -timeconv(doc) -> ["Test that the time unit conversion functions ", - "works."]; -timeconv(Config) when is_list(Config) -> - Val=2, - Secs=Val*1000, - Mins=Secs*60, - Hrs=Mins*60, - Secs=?t:seconds(2), - Mins=?t:minutes(2), - Hrs=?t:hours(2), - ok. - - -msgs(suite) -> []; -msgs(doc) -> ["Tests the messages_get function."]; -msgs(Config) when is_list(Config) -> - self() ! {hej, du}, - self() ! {lite, "data"}, - self() ! en_atom, - [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), - ok. - -capture(suite) -> []; -capture(doc) -> ["Test that the capture functions work properly."]; -capture(Config) when is_list(Config) -> - String1="abcedfghjiklmnopqrstuvwxyz", - String2="0123456789", - ?t:capture_start(), - io:format(String1), - [String1]=?t:capture_get(), - io:format(String2), - [String2]=?t:capture_get(), - ?t:capture_stop(), - []=?t:capture_get(), - io:format(String2), - []=?t:capture_get(), - ok. - -timecall(suite) -> []; -timecall(doc) -> ["Tests that timed calls work."]; -timecall(Config) when is_list(Config) -> - {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), - {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), - DTime=round(Time2), - if - DTime<1 -> - ?t:fail("Timecall reported a too low time."); - DTime==1 -> + rpc:call(Node,test_server_ctrl, stop, []), + {ok,#suite{ n_cases = NCases, + n_cases_failed = NFail, + n_cases_expected = NExpected, + n_cases_succ = NSucc, + n_cases_user_skip = NUsrSkip, + n_cases_auto_skip = NAutoSkip, + cases = Cases }} = Data = + test_server_test_lib:parse_suite( + hd(filelib:wildcard( + filename:join([proplists:get_value(priv_dir, Config), + SuiteName++".logs","run*","suite.log"])))), + {NActualSkip,NActualFail,NActualSucc} = + lists:foldl(fun(#tc{ result = skip },{S,F,Su}) -> + {S+1,F,Su}; + (#tc{ result = ok },{S,F,Su}) -> + {S,F,Su+1}; + (#tc{ result = failed },{S,F,Su}) -> + {S,F+1,Su} + end,{0,0,0},Cases), + Data. + +until(Fun) -> + case Fun() of + true -> ok; - DTime>1 -> - ?t:fail("Timecall reported a too high time.") - end, - ok. - -dummy_function() -> - liten_apa_e_oxo_farlig. -dummy_function(gorilla) -> - receive after 1000 -> ok end, - jag_ar_en_gorilla. - - -do_times(suite) -> [do_times_mfa, do_times_fun]; -do_times(doc) -> ["Test the do_times function."]. - -do_times_mfa(suite) -> []; -do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; -do_times_mfa(Config) when is_list(Config) -> - ?t:do_times(100, ?MODULE, doer, [self()]), - 100=length(?t:messages_get()), - ok. - -do_times_fun(suite) -> []; -do_times_fun(doc) -> ["Test the do_times function with fun given."]; -do_times_fun(Config) when is_list(Config) -> - Self = self(), - ?t:do_times(100, fun() -> doer(Self) end), - 100=length(?t:messages_get()), - ok. - -doer(From) -> - From ! a, - ok. - -skip_cases(doc) -> ["Test all possible ways to skip a test case."]; -skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, - skip_case5, skip_case6, skip_case7, skip_case8, - skip_case9]. - -skip_case1(suite) -> []; -skip_case1(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case1(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - {skipped, "This case should be noted as `Skipped'"}. - -skip_case2(suite) -> []; -skip_case2(doc) -> ["Test that you can return {skipped, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case2(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skipped, Reason} should overwrite a 'comment' - exit({skipped, "This case should be noted as `Skipped'"}). - -skip_case3(suite) -> []; -skip_case3(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case3(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - {skip, "This case should be noted as `Skipped'"}. - -skip_case4(suite) -> []; -skip_case4(doc) -> ["Test that you can return {skip, Reason}," - " and that Reason is in the comment field in the HTML log"]; -skip_case4(Config) when is_list(Config) -> - %% If this comment shows, the case failed!! - ?t:comment("ERROR: This case should have been noted as `Skipped'"), - %% The Reason in {skip, Reason} should overwrite a 'comment' - exit({skip, "This case should be noted as `Skipped'"}). - -skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; -skip_case5(doc) -> ["Test that you can return {skipped, Reason}" - " from the specification clause"]. - -skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; -skip_case6(doc) -> ["Test that you can return {skip, Reason}" - " from the specification clause"]. - -skip_case7(suite) -> []; -skip_case7(doc) -> ["Test that skip works from a test specification file"]; -skip_case7(Config) when is_list(Config) -> - %% This case shall be skipped by adding - %% {skip, {test_server_SUITE, skip_case7, Reason}}. - %% to the test specification file. - ?t:fail("This case should have been Skipped by the .spec file"). - -skip_case8(suite) -> []; -skip_case8(doc) -> ["Test that {skipped, Reason} works from" - " init_per_testcase/2"]; -skip_case8(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skipped, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -skip_case9(suite) -> []; -skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; -skip_case9(Config) when is_list(Config) -> - %% This case shall be skipped by adding a specific clause to - %% returning {skip, Reason} from init_per_testcase/2 for this case. - ?t:fail("This case should have been Skipped by init_per_testcase/2"). - -undefined_functions(suite) -> []; -undefined_functions(doc) -> ["Check for calls to undefined functions in" - " test_server." - "Skip if cover is running"]; -undefined_functions(Config) when is_list(Config) -> - case whereis(cover_server) of - Pid when is_pid(Pid) -> - {skip,"Cover is running"}; - undefined -> - undefined_functions() - end. - -undefined_functions() -> - TestServerDir = filename:dirname(code:which(test_server)), - Res = xref:d(TestServerDir), - - {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), - case Unused of - [] -> ok; - _ -> - lists:foreach(fun (MFA) -> - io:format("~s unused", [format_mfa(MFA)]) - end, Unused) - end, - - {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), - Undef = [U || U <- Undef0, not unresolved(U)], - case Undef of - [] -> ok; - _ -> - lists:foreach(fun ({MFA1,MFA2}) -> - io:format("~s calls undefined ~s", - [format_mfa(MFA1),format_mfa(MFA2)]) - end, Undef), - ?t:fail({length(Undef),undefined_functions_in_otp}) - end, - ok. - -unresolved({_,{_,'$F_EXPR',_}}) -> true; -unresolved(_) -> false. - -format_mfa({M,F,A}) -> - lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). - -conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; -conf_init(Config) when is_list(Config) -> - [{conf_init_var,1389}|Config]. - -check_new_conf(suite) -> []; -check_new_conf(doc) -> ["Check that Config parameter changed by" - " conf_init is used"]; -check_new_conf(Config) when is_list(Config) -> - 1389 = ?config(conf_init_var,Config), - ok. - -conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; -conf_cleanup(Config) when is_list(Config) -> - lists:keydelete(conf_init_var,1,Config). - -check_old_conf(suite) -> []; -check_old_conf(doc) -> ["Test that the restored Config is used after a" - " conf cleanup"]; -check_old_conf(Config) when is_list(Config) -> - undefined = ?config(conf_init_var,Config), - ok. - -conf_init_fail(doc) -> ["Test that config members are skipped if" - " conf init function fails."]; -conf_init_fail(Config) when is_list(Config) -> - ?t:fail("This case should fail! Check that conf_member_skip and" - " conf_cleanup_skip are skipped."). - - - -start_stop_node(suite) -> []; -start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; -start_stop_node(Config) when is_list(Config) -> - {ok,Node2} = ?t:start_node(node2,peer,[]), - {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), - true = lists:member(Node2,nodes()), - - {ok,Node3} = ?t:start_node(node3,slave,[]), - {error, _} = ?t:start_node(node3,slave,[]), - true = lists:member(Node3,nodes()), - - {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), - case lists:member(Node4,nodes()) of - true -> - ?t:comment("WARNING: Node started with {wait,false}" - " is up faster than expected..."); false -> - wait_for_node(Node4,0), - true = lists:member(Node4,nodes()) - end, - - true = ?t:stop_node(Node2), - false = lists:member(Node2,nodes()), - - true = ?t:stop_node(Node3), - false = lists:member(Node3,nodes()), - - true = ?t:stop_node(Node4), - false = lists:member(Node4,nodes()), - timer:sleep(2000), - false = ?t:stop_node(Node4), - - ok. - - -wait_for_node(Node,Acc) -> - case net_adm:ping(Node) of - pang -> timer:sleep(100), - wait_for_node(Node,Acc+100); - pong -> - Acc + until(Fun) end. - -cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" - " is finished unless {cleanup,false} is given."]; -cleanup_nodes_init(Config) when is_list(Config) -> - {ok,DieSlave} = ?t:start_node(die_slave, slave, []), - {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), - {ok,DiePeer} = ?t:start_node(die_peer, peer, []), - {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), - [{die_slave,DieSlave}, - {survive_slave,SurviveSlave}, - {die_peer,DiePeer}, - {survive_peer,SurvivePeer} | Config]. - - - -check_survive_nodes(suite) -> []; -check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; -check_survive_nodes(Config) when is_list(Config) -> - timer:sleep(1000), - false = lists:member(?config(die_slave,Config),nodes()), - true = lists:member(?config(survive_slave,Config),nodes()), - false = lists:member(?config(die_peer,Config),nodes()), - true = lists:member(?config(survive_peer,Config),nodes()), - ok. - - -cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" - " can be stopped"]; -cleanup_nodes_fin(Config) when is_list(Config) -> - Slave = ?config(survive_slave,Config), - Peer = ?config(survive_peer,Config), - - true = ?t:stop_node(Slave), - false = lists:member(Slave,nodes()), - true = ?t:stop_node(Peer), - false = lists:member(Peer,nodes()), - - C1 = lists:keydelete(die_slave,1,Config), - C2 = lists:keydelete(survive_slave,1,C1), - C3 = lists:keydelete(die_peer,1,C2), - lists:keydelete(survive_peer,1,C3). - -commercial(Config) when is_list(Config) -> - case ?t:is_commercial() of - false -> {comment,"Open-source build"}; - true -> {comment,"Commercial build"} - end. - - + diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src new file mode 100644 index 0000000000..d5af919eec --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src @@ -0,0 +1,2 @@ +all: + erlc *.erl
\ No newline at end of file diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl new file mode 100644 index 0000000000..0563e1104f --- /dev/null +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl @@ -0,0 +1,554 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------ +%%% Test Server self test. +%%%------------------------------------------------------------------ +-module(test_server_SUITE). +-include_lib("test_server/include/test_server.hrl"). +-include_lib("test_server/include/test_server_line.hrl"). +-include_lib("kernel/include/file.hrl"). +-export([all/1]). + +-export([init_per_suite/1, end_per_suite/1]). +-export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]). +-export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1, + init_per_s/1, init_per_tc/1, end_per_tc/1, + timeconv/1, msgs/1, capture/1, timecall/1, + do_times/1, do_times_mfa/1, do_times_fun/1, + skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1, + skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1, + skip_case8/1, skip_case9/1, undefined_functions/1, + conf_init/1, check_new_conf/1, conf_cleanup/1, + check_old_conf/1, conf_init_fail/1, start_stop_node/1, + cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1, + commercial/1]). + +-export([dummy_function/0,dummy_function/1,doer/1]). + +all(doc) -> ["Test Server self test"]; +all(suite) -> + [config, comment, timetrap, timetrap_cancel, multiply_timetrap, + init_per_s, init_per_tc, end_per_tc, + timeconv, msgs, capture, timecall, do_times, skip_cases, + undefined_functions, commercial, + {conf, conf_init, [check_new_conf], conf_cleanup}, + check_old_conf, + {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip}, + start_stop_node, + {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin}, + config + ]. + + +init_per_suite(Config) -> + [{init_per_suite_var,ok}|Config]. + +end_per_suite(_Config) -> + ok. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + Config1 = [{watchdog, Dog}|Config], + case Func of + init_per_tc -> + [{strange_var, 1}|Config1]; + skip_case8 -> + {skipped, "This case should be noted as `Skipped'"}; + skip_case9 -> + {skip, "This case should be noted as `Skipped'"}; + _ -> + Config1 + end; +init_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to init_per_testcase not correct"). + +end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + case Func of + end_per_tc -> io:format("CLEANUP => this test case is ok\n"); + _Other -> ok + end; +end_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("Arguments to end_per_testcase not correct"). + +fin_per_testcase(Func, Config) -> + io:format("Func:~p",[Func]), + io:format("Config:~p",[Config]), + ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2"). + + +config(suite) -> []; +config(doc) -> ["Test that the Config variable is decent, ", + "and that the std config variables are correct ", + "(check that data/priv dir exists)." + "Also check that ?config macro works."]; +config(Config) when is_list(Config) -> + is_tuplelist(Config), + {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config), + true=is_dir(Dd), + {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")), + true=is_dir(Dp), + + Dd = ?config(data_dir,Config), + Dp = ?config(priv_dir,Config), + ok; +config(_Config) -> + ?t:fail("Config variable is not a list."). + +is_tuplelist([]) -> + true; +is_tuplelist([{_A,_B}|Rest]) -> + is_tuplelist(Rest); +is_tuplelist(_) -> + false. + +is_dir(Dir) -> + case file:read_file_info(Dir) of + {ok, #file_info{type=directory}} -> + true; + _ -> + false + end. + +comment(suite) -> []; +comment(doc) -> ["Print a comment in the HTML log"]; +comment(Config) when is_list(Config) -> + ?t:comment("This comment should not occur in the HTML log because a later" + " comment shall overwrite it"), + ?t:comment("This comment is printed with the comment/1 function." + " It should occur in the HTML log"). + + + +timetrap(suite) -> []; +timetrap(doc) -> ["Test that timetrap works."]; +timetrap(Config) when is_list(Config) -> + TrapAfter = 3000, + Dog=?t:timetrap(TrapAfter), + process_flag(trap_exit, true), + TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000, + receive + {'EXIT', Dog, {timetrap_timeout, _, _}} -> + ok; + {'EXIT', _OtherPid, {timetrap_timeout, _, _}} -> + ?t:fail("EXIT signal from wrong process") + after + TimeOut -> + ?t:fail("Timetrap is not working.") + end, + ?t:timetrap_cancel(Dog), + ok. + + +timetrap_cancel(suite) -> []; +timetrap_cancel(doc) -> ["Test that timetrap_cancel works."]; +timetrap_cancel(Config) when is_list(Config) -> + Dog=?t:timetrap(1000), + receive + after + 500 -> + ok + end, + ?t:timetrap_cancel(Dog), + receive + after 1000 -> + ok + end, + ok. + +multiply_timetrap(suite) -> []; +multiply_timetrap(doc) -> ["Test multiply timetrap"]; +multiply_timetrap(Config) when is_list(Config) -> + %% This simulates the call to test_server_ctrl:multiply_timetraps/1: + put(test_server_multiply_timetraps,{2,true}), + + Dog = ?t:timetrap(500), + timer:sleep(800), + ?t:timetrap_cancel(Dog), + + %% Reset + put(test_server_multiply_timetraps,1), + ok. + + +init_per_s(suite) -> []; +init_per_s(doc) -> ["Test that a Config that is altered in ", + "init_per_suite gets through to the testcases."]; +init_per_s(Config) -> + %% Check that the config var sent from init_per_suite + %% really exists. + {value, {init_per_suite_var, ok}} = + lists:keysearch(init_per_suite_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +init_per_tc(suite) -> []; +init_per_tc(doc) -> ["Test that a Config that is altered in ", + "init_per_testcase gets through to the ", + "actual testcase."]; +init_per_tc(Config) -> + %% Check that the config var sent from init_per_testcase + %% really exists. + {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config), + + %% Check that the other variables still exist. + {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config), + {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config), + ok. + +end_per_tc(suite) -> []; +end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if" + " test case fails"]; +end_per_tc(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that \"CLEANUP\" is" + " printed in the minor log file."). + + +timeconv(suite) -> []; +timeconv(doc) -> ["Test that the time unit conversion functions ", + "works."]; +timeconv(Config) when is_list(Config) -> + Val=2, + Secs=Val*1000, + Mins=Secs*60, + Hrs=Mins*60, + Secs=?t:seconds(2), + Mins=?t:minutes(2), + Hrs=?t:hours(2), + ok. + + +msgs(suite) -> []; +msgs(doc) -> ["Tests the messages_get function."]; +msgs(Config) when is_list(Config) -> + self() ! {hej, du}, + self() ! {lite, "data"}, + self() ! en_atom, + [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(), + ok. + +capture(suite) -> []; +capture(doc) -> ["Test that the capture functions work properly."]; +capture(Config) when is_list(Config) -> + String1="abcedfghjiklmnopqrstuvwxyz", + String2="0123456789", + ?t:capture_start(), + io:format(String1), + [String1]=?t:capture_get(), + io:format(String2), + [String2]=?t:capture_get(), + ?t:capture_stop(), + []=?t:capture_get(), + io:format(String2), + []=?t:capture_get(), + ok. + +timecall(suite) -> []; +timecall(doc) -> ["Tests that timed calls work."]; +timecall(Config) when is_list(Config) -> + {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []), + {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]), + DTime=round(Time2), + if + DTime<1 -> + ?t:fail("Timecall reported a too low time."); + DTime==1 -> + ok; + DTime>1 -> + ?t:fail("Timecall reported a too high time.") + end, + ok. + +dummy_function() -> + liten_apa_e_oxo_farlig. +dummy_function(gorilla) -> + receive after 1000 -> ok end, + jag_ar_en_gorilla. + + +do_times(suite) -> [do_times_mfa, do_times_fun]; +do_times(doc) -> ["Test the do_times function."]. + +do_times_mfa(suite) -> []; +do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."]; +do_times_mfa(Config) when is_list(Config) -> + ?t:do_times(100, ?MODULE, doer, [self()]), + 100=length(?t:messages_get()), + ok. + +do_times_fun(suite) -> []; +do_times_fun(doc) -> ["Test the do_times function with fun given."]; +do_times_fun(Config) when is_list(Config) -> + Self = self(), + ?t:do_times(100, fun() -> doer(Self) end), + 100=length(?t:messages_get()), + ok. + +doer(From) -> + From ! a, + ok. + +skip_cases(doc) -> ["Test all possible ways to skip a test case."]; +skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4, + skip_case5, skip_case6, skip_case7, skip_case8, + skip_case9]. + +skip_case1(suite) -> []; +skip_case1(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case1(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + {skipped, "This case should be noted as `Skipped'"}. + +skip_case2(suite) -> []; +skip_case2(doc) -> ["Test that you can return {skipped, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case2(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skipped, Reason} should overwrite a 'comment' + exit({skipped, "This case should be noted as `Skipped'"}). + +skip_case3(suite) -> []; +skip_case3(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case3(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + {skip, "This case should be noted as `Skipped'"}. + +skip_case4(suite) -> []; +skip_case4(doc) -> ["Test that you can return {skip, Reason}," + " and that Reason is in the comment field in the HTML log"]; +skip_case4(Config) when is_list(Config) -> + %% If this comment shows, the case failed!! + ?t:comment("ERROR: This case should have been noted as `Skipped'"), + %% The Reason in {skip, Reason} should overwrite a 'comment' + exit({skip, "This case should be noted as `Skipped'"}). + +skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"}; +skip_case5(doc) -> ["Test that you can return {skipped, Reason}" + " from the specification clause"]. + +skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"}; +skip_case6(doc) -> ["Test that you can return {skip, Reason}" + " from the specification clause"]. + +skip_case7(suite) -> []; +skip_case7(doc) -> ["Test that skip works from a test specification file"]; +skip_case7(Config) when is_list(Config) -> + %% This case shall be skipped by adding + %% {skip, {test_server_SUITE, skip_case7, Reason}}. + %% to the test specification file. + ?t:fail("This case should have been Skipped by the .spec file"). + +skip_case8(suite) -> []; +skip_case8(doc) -> ["Test that {skipped, Reason} works from" + " init_per_testcase/2"]; +skip_case8(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skipped, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +skip_case9(suite) -> []; +skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"]; +skip_case9(Config) when is_list(Config) -> + %% This case shall be skipped by adding a specific clause to + %% returning {skip, Reason} from init_per_testcase/2 for this case. + ?t:fail("This case should have been Skipped by init_per_testcase/2"). + +undefined_functions(suite) -> []; +undefined_functions(doc) -> ["Check for calls to undefined functions in" + " test_server." + "Skip if cover is running"]; +undefined_functions(Config) when is_list(Config) -> + case whereis(cover_server) of + Pid when is_pid(Pid) -> + {skip,"Cover is running"}; + undefined -> + undefined_functions() + end. + +undefined_functions() -> + TestServerDir = filename:dirname(code:which(test_server)), + Res = xref:d(TestServerDir), + + {value,{unused,Unused}} = lists:keysearch(unused, 1, Res), + case Unused of + [] -> ok; + _ -> + lists:foreach(fun (MFA) -> + io:format("~s unused", [format_mfa(MFA)]) + end, Unused) + end, + + {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res), + Undef = [U || U <- Undef0, not unresolved(U)], + case Undef of + [] -> ok; + _ -> + lists:foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, Undef), + ?t:fail({length(Undef),undefined_functions_in_otp}) + end, + ok. + +unresolved({_,{_,'$F_EXPR',_}}) -> true; +unresolved(_) -> false. + +format_mfa({M,F,A}) -> + lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). + +conf_init(doc) -> ["Test successful conf case: Change Config parameter"]; +conf_init(Config) when is_list(Config) -> + [{conf_init_var,1389}|Config]. + +check_new_conf(suite) -> []; +check_new_conf(doc) -> ["Check that Config parameter changed by" + " conf_init is used"]; +check_new_conf(Config) when is_list(Config) -> + 1389 = ?config(conf_init_var,Config), + ok. + +conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"]; +conf_cleanup(Config) when is_list(Config) -> + lists:keydelete(conf_init_var,1,Config). + +check_old_conf(suite) -> []; +check_old_conf(doc) -> ["Test that the restored Config is used after a" + " conf cleanup"]; +check_old_conf(Config) when is_list(Config) -> + undefined = ?config(conf_init_var,Config), + ok. + +conf_init_fail(doc) -> ["Test that config members are skipped if" + " conf init function fails."]; +conf_init_fail(Config) when is_list(Config) -> + ?t:fail("This case should fail! Check that conf_member_skip and" + " conf_cleanup_skip are skipped."). + + + +start_stop_node(suite) -> []; +start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"]; +start_stop_node(Config) when is_list(Config) -> + {ok,Node2} = ?t:start_node(node2,peer,[]), + {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]), + true = lists:member(Node2,nodes()), + + {ok,Node3} = ?t:start_node(node3,slave,[]), + {error, _} = ?t:start_node(node3,slave,[]), + true = lists:member(Node3,nodes()), + + {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]), + case lists:member(Node4,nodes()) of + true -> + ?t:comment("WARNING: Node started with {wait,false}" + " is up faster than expected..."); + false -> + wait_for_node(Node4,0), + true = lists:member(Node4,nodes()) + end, + + true = ?t:stop_node(Node2), + false = lists:member(Node2,nodes()), + + true = ?t:stop_node(Node3), + false = lists:member(Node3,nodes()), + + true = ?t:stop_node(Node4), + false = lists:member(Node4,nodes()), + timer:sleep(2000), + false = ?t:stop_node(Node4), + + ok. + + +wait_for_node(Node,Acc) -> + case net_adm:ping(Node) of + pang -> + timer:sleep(100), + wait_for_node(Node,Acc+100); + pong -> + Acc + end. + +cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case" + " is finished unless {cleanup,false} is given."]; +cleanup_nodes_init(Config) when is_list(Config) -> + {ok,DieSlave} = ?t:start_node(die_slave, slave, []), + {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]), + {ok,DiePeer} = ?t:start_node(die_peer, peer, []), + {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]), + [{die_slave,DieSlave}, + {survive_slave,SurviveSlave}, + {die_peer,DiePeer}, + {survive_peer,SurvivePeer} | Config]. + + + +check_survive_nodes(suite) -> []; +check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"]; +check_survive_nodes(Config) when is_list(Config) -> + timer:sleep(1000), + false = lists:member(?config(die_slave,Config),nodes()), + true = lists:member(?config(survive_slave,Config),nodes()), + false = lists:member(?config(die_peer,Config),nodes()), + true = lists:member(?config(survive_peer,Config),nodes()), + ok. + + +cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}" + " can be stopped"]; +cleanup_nodes_fin(Config) when is_list(Config) -> + Slave = ?config(survive_slave,Config), + Peer = ?config(survive_peer,Config), + + true = ?t:stop_node(Slave), + false = lists:member(Slave,nodes()), + true = ?t:stop_node(Peer), + false = lists:member(Peer,nodes()), + + C1 = lists:keydelete(die_slave,1,Config), + C2 = lists:keydelete(survive_slave,1,C1), + C3 = lists:keydelete(die_peer,1,C2), + lists:keydelete(survive_peer,1,C3). + +commercial(Config) when is_list(Config) -> + case ?t:is_commercial() of + false -> {comment,"Open-source build"}; + true -> {comment,"Commercial build"} + end. + + diff --git a/lib/test_server/test/test_server_SUITE_data/dummy_file b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file index 65c88fbd75..65c88fbd75 100644 --- a/lib/test_server/test/test_server_SUITE_data/dummy_file +++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file diff --git a/lib/test_server/test/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl index a6d7dfe851..a6d7dfe851 100644 --- a/lib/test_server/test/test_server_conf01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl diff --git a/lib/test_server/test/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl index deba4660c6..deba4660c6 100644 --- a/lib/test_server/test/test_server_conf02_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl diff --git a/lib/test_server/test/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl index 0e7f329f89..0e7f329f89 100644 --- a/lib/test_server/test/test_server_parallel01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl diff --git a/lib/test_server/test/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl index 7ad269501d..7ad269501d 100644 --- a/lib/test_server/test/test_server_shuffle01_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl diff --git a/lib/test_server/test/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl index 4037e1cc0e..4037e1cc0e 100644 --- a/lib/test_server/test/test_server_skip_SUITE.erl +++ b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl index 02897f164f..aa14862e5a 100644 --- a/lib/test_server/test/test_server_line_SUITE.erl +++ b/lib/test_server/test/test_server_line_SUITE.erl @@ -23,20 +23,29 @@ -module(test_server_line_SUITE). -include_lib("test_server/include/test_server.hrl"). --export([all/1]). --export([init_per_testcase/2, fin_per_testcase/2]). +-export([all/0,suite/0]). +-export([init_per_suite/1,end_per_suite/1, + init_per_testcase/2, end_per_testcase/2]). -export([parse_transform/1, lines/1]). -all(doc) -> ["Test of parse transform for collection line numbers"]; -all(suite) -> [parse_transform,lines]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {doc,["Test of parse transform for collection line numbers"]}]. +all() -> [parse_transform,lines]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. init_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog = ?t:timetrap(?t:minutes(2)), [{watchdog, Dog}|Config]. -fin_per_testcase(_Case, Config) -> +end_per_testcase(_Case, Config) -> ?line test_server_line:clear(), Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog), diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl new file mode 100644 index 0000000000..66ff06e0ce --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.erl @@ -0,0 +1,191 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(test_server_test_lib). +-export([parse_suite/1]). +-export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]). + +-include("test_server_test_lib.hrl"). + +%% The CTH hooks all tests +init(_Id, _Opts) -> + []. + +pre_init_per_testcase(_TC,Config,State) -> + case os:type() of + {win32, _} -> + %% Extend timeout for windows as starting node + %% can take a long time there + test_server:timetrap( 120000 * test_server:timetrap_scale_factor()); + _ -> + ok + end, + {start_slave(Config, 50),State}. + +start_slave(Config,_Level) -> + [_,Host] = string:tokens(atom_to_list(node()), "@"), + + ct:log("Trying to start ~s~n", + ["test_server_tester@"++Host]), + case slave:start(Host, test_server_tester, []) of + {error,Reason} -> + test_server:fail(Reason); + {ok,Node} -> + ct:log("Node ~p started~n", [Node]), + IsCover = test_server:is_cover(), + if IsCover -> + cover:start(Node); + true-> + ok + end, + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + + %% PrivDir as well as directory of Test Server suites + %% have to be in code path on Test Server node. + [_ | Parts] = lists:reverse(filename:split(DataDir)), + TSDir = filename:join(lists:reverse(Parts)), + AddPathDirs = case proplists:get_value(path_dirs, Config) of + undefined -> []; + Ds -> Ds + end, + PathDirs = [PrivDir,TSDir | AddPathDirs], + [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs], + io:format("Dirs added to code path (on ~w):~n", + [Node]), + [io:format("~s~n", [D]) || D <- PathDirs], + + true = rpc:call(Node, os, putenv, + ["TEST_SERVER_FRAMEWORK", "undefined"]), + + ok = rpc:call(Node, file, set_cwd, [PrivDir]), + [{node,Node} | Config] + end. + +post_end_per_testcase(_TC, Config, Return, State) -> + Node = proplists:get_value(node, Config), + cover:stop(Node), + slave:stop(Node), + + {Return, State}. + +%% Parse an .suite log file +parse_suite(FileName) -> + + case file:open(FileName, [read, raw, read_ahead]) of + {ok, Fd} -> + Data = parse_suite(Fd, #suite{ }), + file:close(Fd), + {ok, Data}; + _ -> + error + end. + +fline(Fd) -> + case prim_file:read_line(Fd) of + eof -> eof; + {ok, Line} -> Line + end. + +parse_suite(Fd, S) -> + _Started = fline(Fd), + _Starting = fline(Fd), + "=cases" ++ NCases = fline(Fd), + "=user" ++ _User = fline(Fd), + "=host" ++ Host = fline(Fd), + "=hosts" ++ _Hosts = fline(Fd), + "=emulator_vsn" ++ Evsn = fline(Fd), + "=emulator" ++ Emu = fline(Fd), + "=otp_release" ++ OtpRel = fline(Fd), + "=started" ++ Start = fline(Fd), + NewS = parse_cases(Fd, S#suite{ + n_cases_expected = list_to_int(clean(NCases)), + host = list_to_binary(clean(Host)), + emulator_vsn = list_to_binary(clean(Evsn)), + emulator = list_to_binary(clean(Emu)), + otp_release = list_to_binary(clean(OtpRel)), + started = list_to_binary(clean(Start)) + }), + "=failed" ++ Failed = fline(Fd), + "=successful" ++ Succ = fline(Fd), + "=user_skipped" ++ UsrSkip = fline(Fd), + "=auto_skipped" ++ AutSkip = fline(Fd), + NewS#suite{ n_cases_failed = list_to_int(clean(Failed)), + n_cases_succ = list_to_int(clean(Succ)), + n_cases_user_skip = list_to_int(clean(UsrSkip)), + n_cases_auto_skip = list_to_int(clean(AutSkip)) }. + + +parse_cases(Fd, #suite{ n_cases = N, + cases = Cases } = S) -> + case parse_case(Fd) of + finished -> S#suite{ log_ok = true }; + {eof, Tc} -> + S#suite{ n_cases = N + 1, + cases = [Tc#tc{ result = crashed }|Cases]}; + {ok, Case} -> + parse_cases(Fd, S#suite{ n_cases = N + 1, + cases = [Case|Cases]}) + end. + +parse_case(Fd) -> parse_case(Fd, #tc{}). +parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc). + +parse_case(eof, _, Tc) -> {eof, Tc}; +parse_case("=case" ++ Case, Fd, Tc) -> + Name = list_to_binary(clean(Case)), + parse_case(fline(Fd), Fd, Tc#tc{ name = Name }); +parse_case("=logfile" ++ File, Fd, Tc) -> + Log = list_to_binary(clean(File)), + parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log }); +parse_case("=elapsed" ++ Elapsed, Fd, Tc) -> + {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)), + parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time }); +parse_case("=result" ++ Result, _, Tc) -> + case clean(Result) of + "ok" ++ _ -> + {ok, Tc#tc{ result = ok } }; + "failed" ++ _ -> + {ok, Tc#tc{ result = failed } }; + "skipped" ++ _ -> + {ok, Tc#tc{ result = skip } } + end; +parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) -> + finished; +parse_case(_, Fd, Tc) -> + parse_case(fline(Fd), Fd, Tc). + +skip([]) -> []; +skip([$ |Ts]) -> skip(Ts); +skip(Ts) -> Ts. + +%rmnl(L) -> L. +rmnl([]) -> []; +rmnl([$\n | Ts]) -> rmnl(Ts); +rmnl([T|Ts]) -> [T | rmnl(Ts)]. + +clean(L) -> + rmnl(skip(L)). + +list_to_int(L) -> + try + list_to_integer(L) + catch + _:_ -> + 0 + end. diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/test_server/test/test_server_test_lib.hrl new file mode 100644 index 0000000000..27b7be9618 --- /dev/null +++ b/lib/test_server/test/test_server_test_lib.hrl @@ -0,0 +1,23 @@ +-record(tc, { + name, + result, + elapsed, + logfile + }). + +-record(suite, { + application, + n_cases = 0, + n_cases_failed = 0, + n_cases_expected = 0, + n_cases_succ, + n_cases_user_skip, + n_cases_auto_skip, + cases = [], + host, + emulator_vsn, + emulator, + otp_release, + started, + log_ok = false + }). diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml index 323bd0dda8..0a3302bda5 100644 --- a/lib/tools/doc/src/cover.xml +++ b/lib/tools/doc/src/cover.xml @@ -270,6 +270,8 @@ defaults to <c>function</c>.</p> <p>If <c>Module</c> is not Cover compiled, the function returns <c>{error,{not_cover_compiled,Module}}</c>.</p> + <p>HINT: It is possible to issue multiple analyse_to_file commands at + the same time. </p> </desc> </func> <func> @@ -307,6 +309,33 @@ <c>.beam</c> file, or in <c>../src</c> relative to that directory. If no source code is found, <c>,{error,no_source_code_found}</c> is returned.</p> + <p>HINT: It is possible to issue multiple analyse_to_file commands at + the same time. </p> + </desc> + </func> + <func> + <name>async_analyse_to_file(Module) -> </name> + <name>async_analyse_to_file(Module,Options) -> </name> + <name>async_analyse_to_file(Module, OutFile) -> </name> + <name>async_analyse_to_file(Module, OutFile, Options) -> pid()</name> + <fsummary>Asynchronous call to analyse_to_file.</fsummary> + <type> + <v>Module = atom()</v> + <v>OutFile = string()</v> + <v>Options = [Option]</v> + <v>Option = html</v> + <v>Error = {not_cover_compiled,Module} | {file,File,Reason} | no_source_code_found | not_main_node</v> + <v> File = string()</v> + <v> Reason = term()</v> + </type> + <desc> + <p>This function works exactly the same way as + <seealso marker="#analyse_to_file-1">analyse_to_file</seealso> except + that it is asynchronous instead of synchronous. The spawned process + will link with the caller when created. If an <c>Error</c> occurs + while doing the cover analysis the process will crash with the same + error reason as <seealso marker="#analyse_to_file-1">analyse_to_file</seealso> + would return.</p> </desc> </func> <func> diff --git a/lib/tools/doc/src/cover_chapter.xml b/lib/tools/doc/src/cover_chapter.xml index b4f7919183..92a790c34e 100644 --- a/lib/tools/doc/src/cover_chapter.xml +++ b/lib/tools/doc/src/cover_chapter.xml @@ -403,6 +403,13 @@ ok database contains information about each executable line in each Cover compiled module, performance decreases proportionally to the size and number of the Cover compiled modules.</p> + <p>To improve performance when analysing cover results it is possible + to do multiple calls to <seealso marker="cover#analyse-1">analyse</seealso> + and <seealso marker="cover#analyse_to_file-1">analyse_to_file</seealso> + at once. You can also use the + <seealso marker="cover#async_analyse_to_file-1">async_analyse_to_file</seealso> + convenience function. + </p> </section> <section> diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index c4d1bd1d2f..ada2db45be 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -35,23 +35,37 @@ %% remote_process_loop/1. %% %% TABLES -%% Each nodes has an ets table named 'cover_internal_data_table' -%% (?COVER_TABLE). This table contains the coverage data and is -%% continously updated when cover compiled code is executed. +%% Each nodes has two tables: cover_internal_data_table (?COVER_TABLE) and. +%% cover_internal_clause_table (?COVER_CLAUSE_TABLE). +%% ?COVER_TABLE contains the bump data i.e. the data about which lines +%% have been executed how many times. +%% ?COVER_CLAUSE_TABLE contains information about which clauses in which modules +%% cover is currently collecting statistics. %% -%% The main node owns a table named -%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE). This table -%% contains data which is collected from remote nodes (either when a -%% remote node is stopped with cover:stop/1 or when analysing. When -%% analysing, data is even moved from the ?COVER_TABLE on the main -%% node to the ?COLLECTION_TABLE. +%% The main node owns tables named +%% 'cover_collected_remote_data_table' (?COLLECTION_TABLE) and +%% 'cover_collected_remote_clause_table' (?COLLECTION_CLAUSE_TABLE). +%% These tables contain data which is collected from remote nodes (either when a +%% remote node is stopped with cover:stop/1 or when analysing). When +%% analysing, data is even moved from the COVER tables on the main +%% node to the COLLECTION tables. %% %% The main node also has a table named 'cover_binary_code_table' %% (?BINARY_TABLE). This table contains the binary code for each cover %% compiled module. This is necessary so that the code can be loaded %% on remote nodes that are started after the compilation. %% - +%% PARELLALISM +%% To take advantage of SMP when doing the cover analysis both the data +%% collection and analysis has been parallelized. One process is spawned for +%% each node when collecting data, and on the remote node when collecting data +%% one process is spawned per module. +%% +%% When analyzing data it is possible to issue multiple analyse(_to_file)/X +%% calls at once. They are however all calls (for backwardscompatability +%% reasons) so the user of cover will have to spawn several processes to to the +%% calls ( or use async_analyse_to_file ). +%% %% External exports -export([start/0, start/1, @@ -61,6 +75,9 @@ analyse/1, analyse/2, analyse/3, analyze/1, analyze/2, analyze/3, analyse_to_file/1, analyse_to_file/2, analyse_to_file/3, analyze_to_file/1, analyze_to_file/2, analyze_to_file/3, + async_analyse_to_file/1,async_analyse_to_file/2, + async_analyse_to_file/3, async_analyze_to_file/1, + async_analyze_to_file/2, async_analyze_to_file/3, export/1, export/2, import/1, modules/0, imported/0, imported_modules/0, which_nodes/0, is_compiled/1, reset/1, reset/0, @@ -100,8 +117,10 @@ }). -define(COVER_TABLE, 'cover_internal_data_table'). +-define(COVER_CLAUSE_TABLE, 'cover_internal_clause_table'). -define(BINARY_TABLE, 'cover_binary_code_table'). -define(COLLECTION_TABLE, 'cover_collected_remote_data_table'). +-define(COLLECTION_CLAUSE_TABLE, 'cover_collected_remote_clause_table'). -define(TAG, cover_compiled). -define(SERVER, cover_server). @@ -114,6 +133,8 @@ true -> ?BLOCK(Expr) end). +-define(SPAWN_DBG(Tag,Value),put(Tag,Value)). + -include_lib("stdlib/include/ms_transform.hrl"). %%%---------------------------------------------------------------------- @@ -127,7 +148,10 @@ start() -> case whereis(?SERVER) of undefined -> Starter = self(), - Pid = spawn(fun() -> init_main(Starter) end), + Pid = spawn(fun() -> + ?SPAWN_DBG(start,[]), + init_main(Starter) + end), Ref = erlang:monitor(process,Pid), Return = receive @@ -382,6 +406,30 @@ analyze_to_file(Module, OptOrOut) -> analyse_to_file(Module, OptOrOut). analyze_to_file(Module, OutFile, Options) -> analyse_to_file(Module, OutFile, Options). +async_analyse_to_file(Module) -> + do_spawn(?MODULE, analyse_to_file, [Module]). +async_analyse_to_file(Module, OutFileOrOpts) -> + do_spawn(?MODULE, analyse_to_file, [Module, OutFileOrOpts]). +async_analyse_to_file(Module, OutFile, Options) -> + do_spawn(?MODULE, analyse_to_file, [Module, OutFile, Options]). + +do_spawn(M,F,A) -> + spawn_link(fun() -> + case apply(M,F,A) of + {ok, _} -> + ok; + {error, Reason} -> + exit(Reason) + end + end). + +async_analyze_to_file(Module) -> + async_analyse_to_file(Module). +async_analyze_to_file(Module, OutFileOrOpts) -> + async_analyse_to_file(Module, OutFileOrOpts). +async_analyze_to_file(Module, OutFile, Options) -> + async_analyse_to_file(Module, OutFile, Options). + outfilename(Module,Opts) -> case lists:member(html,Opts) of true -> @@ -500,6 +548,8 @@ remote_call(Node,Request) -> Return end. +remote_reply(Proc,Reply) when is_pid(Proc) -> + Proc ! {?SERVER,Reply}; remote_reply(MainNode,Reply) -> {?SERVER,MainNode} ! {?SERVER,Reply}. @@ -509,9 +559,15 @@ remote_reply(MainNode,Reply) -> init_main(Starter) -> register(?SERVER,self()), - ets:new(?COVER_TABLE, [set, public, named_table]), + %% Having write concurrancy here gives a 40% performance boost + %% when collect/1 is called. + ets:new(?COVER_TABLE, [set, public, named_table + ,{write_concurrency, true} + ]), + ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]), ets:new(?BINARY_TABLE, [set, named_table]), ets:new(?COLLECTION_TABLE, [set, public, named_table]), + ets:new(?COLLECTION_CLAUSE_TABLE, [set, public, named_table]), process_flag(trap_exit,true), Starter ! {?SERVER,started}, main_process_loop(#main_state{}). @@ -593,40 +649,10 @@ main_process_loop(State) -> end; {From, {export,OutFile,Module}} -> - case file:open(OutFile,[write,binary,raw]) of - {ok,Fd} -> - Reply = - case Module of - '_' -> - export_info(State#main_state.imported), - collect(State#main_state.nodes), - do_export_table(State#main_state.compiled, - State#main_state.imported, - Fd); - _ -> - export_info(Module,State#main_state.imported), - case is_loaded(Module, State) of - {loaded, File} -> - [{Module,Clauses}] = - ets:lookup(?COVER_TABLE,Module), - collect(Module, Clauses, - State#main_state.nodes), - do_export_table([{Module,File}],[],Fd); - {imported, File, ImportFiles} -> - %% don't know if I should allow this - - %% export a module which is only imported - Imported = [{Module,File,ImportFiles}], - do_export_table([],Imported,Fd); - _NotLoaded -> - {error,{not_cover_compiled,Module}} - end - end, - file:close(Fd), - reply(From, Reply); - {error,Reason} -> - reply(From, {error, {cant_open_file,OutFile,Reason}}) - - end, + spawn(fun() -> + ?SPAWN_DBG(export,{OutFile, Module}), + do_export(Module, OutFile, From, State) + end), main_process_loop(State); {From, {import,File}} -> @@ -692,107 +718,73 @@ main_process_loop(State) -> unregister(?SERVER), reply(From, ok); - {From, {Request, Module}} -> - case is_loaded(Module, State) of - {loaded, File} -> - {Reply,State1} = - case Request of - {analyse, Analysis, Level} -> - analyse_info(Module,State#main_state.imported), - [{Module,Clauses}] = - ets:lookup(?COVER_TABLE,Module), - collect(Module,Clauses,State#main_state.nodes), - R = do_analyse(Module, Analysis, Level, Clauses), - {R,State}; - - {analyse_to_file, OutFile, Opts} -> - R = case find_source(File) of - {beam,_BeamFile} -> - {error,no_source_code_found}; - ErlFile -> - Imported = State#main_state.imported, - analyse_info(Module,Imported), - [{Module,Clauses}] = - ets:lookup(?COVER_TABLE,Module), - collect(Module, Clauses, - State#main_state.nodes), - HTML = lists:member(html,Opts), - do_analyse_to_file(Module,OutFile, - ErlFile,HTML) - end, - {R,State}; - - is_compiled -> - {{file, File},State}; - - reset -> - R = do_reset_main_node(Module, - State#main_state.nodes), - Imported = - remove_imported(Module, - State#main_state.imported), - {R,State#main_state{imported=Imported}} - end, - reply(From, Reply), - main_process_loop(State1); - - {imported,File,_ImportFiles} -> - {Reply,State1} = - case Request of - {analyse, Analysis, Level} -> - analyse_info(Module,State#main_state.imported), - [{Module,Clauses}] = - ets:lookup(?COLLECTION_TABLE,Module), - R = do_analyse(Module, Analysis, Level, Clauses), - {R,State}; - - {analyse_to_file, OutFile, Opts} -> - R = case find_source(File) of - {beam,_BeamFile} -> - {error,no_source_code_found}; - ErlFile -> - Imported = State#main_state.imported, - analyse_info(Module,Imported), - HTML = lists:member(html,Opts), - do_analyse_to_file(Module,OutFile, - ErlFile,HTML) - end, - {R,State}; - - is_compiled -> - {false,State}; - - reset -> - R = do_reset_collection_table(Module), - Imported = - remove_imported(Module, - State#main_state.imported), - {R,State#main_state{imported=Imported}} - end, - reply(From, Reply), - main_process_loop(State1); - - NotLoaded -> - Reply = - case Request of - is_compiled -> - false; - _ -> - {error, {not_cover_compiled,Module}} - end, - Compiled = - case NotLoaded of - unloaded -> - do_clear(Module), - remote_unload(State#main_state.nodes,[Module]), - update_compiled([Module], - State#main_state.compiled); - false -> - State#main_state.compiled + {From, {{analyse, Analysis, Level}, Module}} -> + S = try + Loaded = is_loaded(Module, State), + spawn(fun() -> + ?SPAWN_DBG(analyse,{Module,Analysis, Level}), + do_parallel_analysis( + Module, Analysis, Level, + Loaded, From, State) + end), + State + catch throw:Reason -> + reply(From,{error, {not_cover_compiled,Module}}), + not_loaded(Module, Reason, State) + end, + main_process_loop(S); + + {From, {{analyse_to_file, OutFile, Opts},Module}} -> + S = try + Loaded = is_loaded(Module, State), + spawn(fun() -> + ?SPAWN_DBG(analyse_to_file, + {Module,OutFile, Opts}), + do_parallel_analysis_to_file( + Module, OutFile, Opts, + Loaded, From, State) + end), + State + catch throw:Reason -> + reply(From,{error, {not_cover_compiled,Module}}), + not_loaded(Module, Reason, State) + end, + main_process_loop(S); + + {From, {is_compiled, Module}} -> + S = try is_loaded(Module, State) of + {loaded, File} -> + reply(From,{file, File}), + State; + {imported,_File,_ImportFiles} -> + reply(From,false), + State + catch throw:Reason -> + reply(From,false), + not_loaded(Module, Reason, State) + end, + main_process_loop(S); + + {From, {reset, Module}} -> + S = try + Loaded = is_loaded(Module,State), + R = case Loaded of + {loaded, _File} -> + do_reset_main_node( + Module, State#main_state.nodes); + {imported, _File, _} -> + do_reset_collection_table(Module) end, - reply(From, Reply), - main_process_loop(State#main_state{compiled=Compiled}) - end; + Imported = + remove_imported(Module, + State#main_state.imported), + reply(From, R), + State#main_state{imported=Imported} + catch throw:Reason -> + reply(From,{error, {not_cover_compiled,Module}}), + not_loaded(Module, Reason, State) + end, + main_process_loop(S); {'EXIT',Pid,_Reason} -> %% Exit is trapped on the main node only, so this will only happen @@ -807,17 +799,17 @@ main_process_loop(State) -> main_process_loop(State) end. - - - - %%%---------------------------------------------------------------------- %%% cover_server on remote node %%%---------------------------------------------------------------------- init_remote(Starter,MainNode) -> register(?SERVER,self()), - ets:new(?COVER_TABLE, [set, public, named_table]), + ets:new(?COVER_TABLE, [set, public, named_table + %% write_concurrency here makes otp_8270 break :( + %,{write_concurrency, true} + ]), + ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]), Starter ! {self(),started}, remote_process_loop(#remote_state{main_node=MainNode}). @@ -843,29 +835,14 @@ remote_process_loop(State) -> remote_process_loop(State); {remote,collect,Module,CollectorPid} -> - MS = - case Module of - '_' -> ets:fun2ms(fun({M,C}) when is_atom(M) -> C end); - _ -> ets:fun2ms(fun({M,C}) when M=:=Module -> C end) - end, - AllClauses = lists:flatten(ets:select(?COVER_TABLE,MS)), - - %% Sending clause by clause in order to avoid large lists - lists:foreach( - fun({M,F,A,C,_L}) -> - Pattern = - {#bump{module=M, function=F, arity=A, clause=C}, '_'}, - Bumps = ets:match_object(?COVER_TABLE, Pattern), - %% Reset - lists:foreach(fun({Bump,_N}) -> - ets:insert(?COVER_TABLE, {Bump,0}) - end, - Bumps), - CollectorPid ! {chunk,Bumps} - end, - AllClauses), - CollectorPid ! done, - remote_reply(State#remote_state.main_node, ok), + self() ! {remote,collect,Module,CollectorPid, ?SERVER}; + + {remote,collect,Module,CollectorPid,From} -> + spawn(fun() -> + ?SPAWN_DBG(remote_collect, + {Module, CollectorPid, From}), + do_collect(Module, CollectorPid, From) + end), remote_process_loop(State); {remote,stop} -> @@ -894,6 +871,33 @@ remote_process_loop(State) -> end. +do_collect(Module, CollectorPid, From) -> + AllMods = + case Module of + '_' -> ets:tab2list(?COVER_CLAUSE_TABLE); + _ -> ets:lookup(?COVER_CLAUSE_TABLE, Module) + end, + + %% Sending clause by clause in order to avoid large lists + pmap( + fun({_Mod,Clauses}) -> + lists:map(fun(Clause) -> + send_collected_data(Clause, CollectorPid) + end,Clauses) + end,AllMods), + CollectorPid ! done, + remote_reply(From, ok). + +send_collected_data({M,F,A,C,_L}, CollectorPid) -> + Pattern = + {#bump{module=M, function=F, arity=A, clause=C}, '_'}, + Bumps = ets:match_object(?COVER_TABLE, Pattern), + %% Reset + lists:foreach(fun({Bump,_N}) -> + ets:insert(?COVER_TABLE, {Bump,0}) + end, + Bumps), + CollectorPid ! {chunk,Bumps}. reload_originals([{Module,_File}|Compiled]) -> do_reload_original(Module), @@ -932,6 +936,9 @@ load_compiled([{Module,File,Binary,InitialTable}|Compiled],Acc) -> load_compiled([],Acc) -> Acc. +insert_initial_data([Item|Items]) when is_atom(element(1,Item)) -> + ets:insert(?COVER_CLAUSE_TABLE, Item), + insert_initial_data(Items); insert_initial_data([Item|Items]) -> ets:insert(?COVER_TABLE, Item), insert_initial_data(Items); @@ -957,7 +964,10 @@ remote_start(MainNode) -> case whereis(?SERVER) of undefined -> Starter = self(), - Pid = spawn(fun() -> init_remote(Starter,MainNode) end), + Pid = spawn(fun() -> + ?SPAWN_DBG(remote_start,{MainNode}), + init_remote(Starter,MainNode) + end), Ref = erlang:monitor(process,Pid), Return = receive @@ -972,14 +982,25 @@ remote_start(MainNode) -> {error,{already_started,Pid}} end. -%% Load a set of cover compiled modules on remote nodes -remote_load_compiled(Nodes,Compiled0) -> - Compiled = lists:map(fun get_data_for_remote_loading/1,Compiled0), +%% Load a set of cover compiled modules on remote nodes, +%% We do it ?MAX_MODS modules at a time so that we don't +%% run out of memory on the cover_server node. +-define(MAX_MODS, 10). +remote_load_compiled(Nodes,Compiled) -> + remote_load_compiled(Nodes, Compiled, [], 0). +remote_load_compiled(_Nodes, [], [], _ModNum) -> + ok; +remote_load_compiled(Nodes, Compiled, Acc, ModNum) + when Compiled == []; ModNum == ?MAX_MODS -> lists:foreach( fun(Node) -> - remote_call(Node,{remote,load_compiled,Compiled}) + remote_call(Node,{remote,load_compiled,Acc}) end, - Nodes). + Nodes), + remote_load_compiled(Nodes, Compiled, [], 0); +remote_load_compiled(Nodes, [MF | Rest], Acc, ModNum) -> + remote_load_compiled( + Nodes, Rest, [get_data_for_remote_loading(MF) | Acc], ModNum + 1). %% Read all data needed for loading a cover compiled module on a remote node %% Binary is the beam code for the module and InitialTable is the initial @@ -987,15 +1008,15 @@ remote_load_compiled(Nodes,Compiled0) -> get_data_for_remote_loading({Module,File}) -> [{Module,Binary}] = ets:lookup(?BINARY_TABLE,Module), %%! The InitialTable list will be long if the module is big - what to do?? - InitialTable = ets:select(?COVER_TABLE,ms(Module)), - {Module,File,Binary,InitialTable}. + InitialBumps = ets:select(?COVER_TABLE,ms(Module)), + InitialClauses = ets:lookup(?COVER_CLAUSE_TABLE,Module), + + {Module,File,Binary,InitialBumps ++ InitialClauses}. %% Create a match spec which returns the clause info {Module,InitInfo} and %% all #bump keys for the given module with 0 number of calls. ms(Module) -> - ets:fun2ms(fun({Module,InitInfo}) -> - {Module,InitInfo}; - ({Key,_}) when is_record(Key,bump),Key#bump.module=:=Module -> + ets:fun2ms(fun({Key,_}) when Key#bump.module=:=Module -> {Key,0} end). @@ -1017,27 +1038,30 @@ remote_reset(Module,Nodes) -> %% Collect data from remote nodes - used for analyse or stop(Node) remote_collect(Module,Nodes,Stop) -> - CollectorPid = spawn(fun() -> collector_proc(length(Nodes)) end), - lists:foreach( - fun(Node) -> - remote_call(Node,{remote,collect,Module,CollectorPid}), - if Stop -> remote_call(Node,{remote,stop}); - true -> ok - end - end, - Nodes). + pmap(fun(Node) -> + ?SPAWN_DBG(remote_collect, + {Module, Nodes, Stop}), + do_collection(Node, Module, Stop) + end, + Nodes). + +do_collection(Node, Module, Stop) -> + CollectorPid = spawn(fun collector_proc/0), + remote_call(Node,{remote,collect,Module,CollectorPid, self()}), + if Stop -> remote_call(Node,{remote,stop}); + true -> ok + end. %% Process which receives chunks of data from remote nodes - either when %% analysing or when stopping cover on the remote nodes. -collector_proc(0) -> - ok; -collector_proc(N) -> +collector_proc() -> + ?SPAWN_DBG(collector_proc, []), receive {chunk,Chunk} -> insert_in_collection_table(Chunk), - collector_proc(N); + collector_proc(); done -> - collector_proc(N-1) + ok end. insert_in_collection_table([{Key,Val}|Chunk]) -> @@ -1052,7 +1076,13 @@ insert_in_collection_table(Key,Val) -> ets:update_counter(?COLLECTION_TABLE, Key,Val); false -> - ets:insert(?COLLECTION_TABLE,{Key,Val}) + %% Make sure that there are no race conditions from ets:member + case ets:insert_new(?COLLECTION_TABLE,{Key,Val}) of + false -> + insert_in_collection_table(Key,Val); + _ -> + ok + end end. @@ -1073,14 +1103,15 @@ analyse_info(Module,Imported) -> export_info(_Module,[]) -> ok; -export_info(Module,Imported) -> - imported_info("Export",Module,Imported). +export_info(_Module,_Imported) -> + %% Do not print that the export includes imported modules + ok. export_info([]) -> ok; -export_info(Imported) -> - AllImportFiles = get_all_importfiles(Imported,[]), - io:format("Export includes data from imported files\n~p\n",[AllImportFiles]). +export_info(_Imported) -> + %% Do not print that the export includes imported modules + ok. get_all_importfiles([{_M,_F,ImportFiles}|Imported],Acc) -> NewAcc = do_get_all_importfiles(ImportFiles,Acc), @@ -1153,14 +1184,14 @@ is_loaded(Module, State) -> {ok, File} -> case code:which(Module) of ?TAG -> {loaded, File}; - _ -> unloaded + _ -> throw(unloaded) end; false -> case get_file(Module,State#main_state.imported) of {ok,File,ImportFiles} -> {imported, File, ImportFiles}; false -> - false + throw(not_loaded) end end. @@ -1259,7 +1290,7 @@ do_compile_beam(Module,Beam) -> %% Store info about all function clauses in database InitInfo = reverse(Vars#vars.init_info), - ets:insert(?COVER_TABLE, {Module, InitInfo}), + ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), %% Store binary code so it can be loaded on remote nodes ets:insert(?BINARY_TABLE, {Module, Binary}), @@ -1793,9 +1824,8 @@ common_elems(L1, L2) -> %% Collect data for all modules collect(Nodes) -> %% local node - MS = ets:fun2ms(fun({M,C}) when is_atom(M) -> {M,C} end), - AllClauses = ets:select(?COVER_TABLE,MS), - move_modules(AllClauses), + AllClauses = ets:tab2list(?COVER_CLAUSE_TABLE), + pmap(fun move_modules/1,AllClauses), %% remote nodes remote_collect('_',Nodes,false). @@ -1803,7 +1833,7 @@ collect(Nodes) -> %% Collect data for one module collect(Module,Clauses,Nodes) -> %% local node - move_modules([{Module,Clauses}]), + move_modules({Module,Clauses}), %% remote nodes remote_collect(Module,Nodes,false). @@ -1811,12 +1841,9 @@ collect(Module,Clauses,Nodes) -> %% When analysing, the data from the local ?COVER_TABLE is moved to the %% ?COLLECTION_TABLE. Resetting data in ?COVER_TABLE -move_modules([{Module,Clauses}|AllClauses]) -> - ets:insert(?COLLECTION_TABLE,{Module,Clauses}), - move_clauses(Clauses), - move_modules(AllClauses); -move_modules([]) -> - ok. +move_modules({Module,Clauses}) -> + ets:insert(?COLLECTION_CLAUSE_TABLE,{Module,Clauses}), + move_clauses(Clauses). move_clauses([{M,F,A,C,_L}|Clauses]) -> Pattern = {#bump{module=M, function=F, arity=A, clause=C}, '_'}, @@ -1855,6 +1882,22 @@ find_source(File0) -> end end. +do_parallel_analysis(Module, Analysis, Level, Loaded, From, State) -> + analyse_info(Module,State#main_state.imported), + C = case Loaded of + {loaded, _File} -> + [{Module,Clauses}] = + ets:lookup(?COVER_CLAUSE_TABLE,Module), + collect(Module,Clauses,State#main_state.nodes), + Clauses; + _ -> + [{Module,Clauses}] = + ets:lookup(?COLLECTION_CLAUSE_TABLE,Module), + Clauses + end, + R = do_analyse(Module, Analysis, Level, C), + reply(From, R). + %% do_analyse(Module, Analysis, Level, Clauses)-> {ok,Answer} | {error,Error} %% Clauses = [{Module,Function,Arity,Clause,Lines}] do_analyse(Module, Analysis, line, _Clauses) -> @@ -1931,6 +1974,28 @@ merge_functions([{_MFA,R}|Functions], MFun, Result) -> merge_functions([], _MFun, Result) -> Result. +do_parallel_analysis_to_file(Module, OutFile, Opts, Loaded, From, State) -> + File = case Loaded of + {loaded, File0} -> + [{Module,Clauses}] = + ets:lookup(?COVER_CLAUSE_TABLE,Module), + collect(Module, Clauses, + State#main_state.nodes), + File0; + {imported, File0, _} -> + File0 + end, + case find_source(File) of + {beam,_BeamFile} -> + reply(From, {error,no_source_code_found}); + ErlFile -> + analyse_info(Module,State#main_state.imported), + HTML = lists:member(html,Opts), + R = do_analyse_to_file(Module,OutFile, + ErlFile,HTML), + reply(From, R) + end. + %% do_analyse_to_file(Module,OutFile,ErlFile) -> {ok,OutFile} | {error,Error} %% Module = atom() %% OutFile = ErlFile = string() @@ -2027,6 +2092,42 @@ fill2() -> ".| ". fill3() -> "| ". %%%--Export-------------------------------------------------------------- +do_export(Module, OutFile, From, State) -> + case file:open(OutFile,[write,binary,raw]) of + {ok,Fd} -> + Reply = + case Module of + '_' -> + export_info(State#main_state.imported), + collect(State#main_state.nodes), + do_export_table(State#main_state.compiled, + State#main_state.imported, + Fd); + _ -> + export_info(Module,State#main_state.imported), + try is_loaded(Module, State) of + {loaded, File} -> + [{Module,Clauses}] = + ets:lookup(?COVER_CLAUSE_TABLE,Module), + collect(Module, Clauses, + State#main_state.nodes), + do_export_table([{Module,File}],[],Fd); + {imported, File, ImportFiles} -> + %% don't know if I should allow this - + %% export a module which is only imported + Imported = [{Module,File,ImportFiles}], + do_export_table([],Imported,Fd) + catch throw:_ -> + {error,{not_cover_compiled,Module}} + end + end, + file:close(Fd), + reply(From, Reply); + {error,Reason} -> + reply(From, {error, {cant_open_file,OutFile,Reason}}) + + end. + do_export_table(Compiled, Imported, Fd) -> ModList = merge(Imported,Compiled), write_module_data(ModList,Fd). @@ -2043,7 +2144,7 @@ merge([],ModuleList) -> write_module_data([{Module,File}|ModList],Fd) -> write({file,Module,File},Fd), - [Clauses] = ets:lookup(?COLLECTION_TABLE,Module), + [Clauses] = ets:lookup(?COLLECTION_CLAUSE_TABLE,Module), write(Clauses,Fd), ModuleData = ets:match_object(?COLLECTION_TABLE,{#bump{module=Module},'_'}), do_write_module_data(ModuleData,Fd), @@ -2093,7 +2194,7 @@ do_import_to_table(Fd,ImportFile,Imported,DontImport) -> {Module,Clauses} -> case lists:member(Module,DontImport) of false -> - ets:insert(?COLLECTION_TABLE,{Module,Clauses}); + ets:insert(?COLLECTION_CLAUSE_TABLE,{Module,Clauses}); true -> ok end, @@ -2127,14 +2228,14 @@ do_reset_main_node(Module,Nodes) -> remote_reset(Module,Nodes). do_reset_collection_table(Module) -> - ets:delete(?COLLECTION_TABLE,Module), + ets:delete(?COLLECTION_CLAUSE_TABLE,Module), ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}). %% do_reset(Module) -> ok %% The reset is done on a per-clause basis to avoid building %% long lists in the case of very large modules do_reset(Module) -> - [{Module,Clauses}] = ets:lookup(?COVER_TABLE, Module), + [{Module,Clauses}] = ets:lookup(?COVER_CLAUSE_TABLE, Module), do_reset2(Clauses). do_reset2([{M,F,A,C,_L}|Clauses]) -> @@ -2149,10 +2250,19 @@ do_reset2([]) -> ok. do_clear(Module) -> - ets:match_delete(?COVER_TABLE, {Module,'_'}), + ets:match_delete(?COVER_CLAUSE_TABLE, {Module,'_'}), ets:match_delete(?COVER_TABLE, {#bump{module=Module},'_'}), ets:match_delete(?COLLECTION_TABLE, {#bump{module=Module},'_'}). +not_loaded(Module, unloaded, State) -> + do_clear(Module), + remote_unload(State#main_state.nodes,[Module]), + Compiled = update_compiled([Module], + State#main_state.compiled), + State#main_state{ compiled = Compiled }; +not_loaded(_Module,_Else, State) -> + State. + %%%--Div----------------------------------------------------------------- @@ -2180,3 +2290,30 @@ escape_lt_and_gt1([],Acc) -> lists:reverse(Acc); escape_lt_and_gt1([H|T],Acc) -> escape_lt_and_gt1(T,[H|Acc]). + +pmap(Fun, List) -> + pmap(Fun, List, 20). +pmap(Fun, List, Limit) -> + pmap(Fun, List, [], Limit, 0, []). +pmap(Fun, [E | Rest], Pids, Limit, Cnt, Acc) when Cnt < Limit -> + Collector = self(), + Pid = spawn_link(fun() -> + ?SPAWN_DBG(pmap,E), + Collector ! {res,self(),Fun(E)} + end), + erlang:monitor(process, Pid), + pmap(Fun, Rest, Pids ++ [Pid], Limit, Cnt + 1, Acc); +pmap(Fun, List, [Pid | Pids], Limit, Cnt, Acc) -> + receive + {'DOWN', _Ref, process, _, _} -> + pmap(Fun, List, [Pid | Pids], Limit, Cnt - 1, Acc); + {res, Pid, Res} -> + pmap(Fun, List, Pids, Limit, Cnt, [Res | Acc]) + end; +pmap(_Fun, [], [], _Limit, 0, Acc) -> + lists:reverse(Acc); +pmap(Fun, [], [], Limit, Cnt, Acc) -> + receive + {'DOWN', _Ref, process, _, _} -> + pmap(Fun, [], [], Limit, Cnt - 1, Acc) + end. diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index d9daff7a1f..494ef55f59 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -18,8 +18,10 @@ %% -module(cover_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, init_per_testcase/2, end_per_testcase/2, + suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). + -export([start/1, compile/1, analyse/1, misc/1, stop/1, distribution/1, export_import/1, otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, @@ -68,6 +70,19 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(TC, Config) when TC =:= misc; TC =:= compile -> + case code:which(crypto) of + Path when is_list(Path) -> + init_per_testcase(dummy_tc, Config); + _Else -> + {skip, "No crypto file to test with"} + end; +init_per_testcase(_TestCase, Config) -> + Config. + +end_per_testcase(_TestCase, _Config) -> + %cover:stop(), + ok. start(suite) -> []; start(Config) when is_list(Config) -> @@ -401,8 +416,8 @@ export_import(Config) when is_list(Config) -> ?line {ok,a} = cover:compile(a), ?line ?t:capture_start(), ?line ok = cover:export("all_exported"), - ?line [Text2] = ?t:capture_get(), - ?line "Export includes data from imported files"++_ = lists:flatten(Text2), + ?line [] = ?t:capture_get(), +% ?line "Export includes data from imported files"++_ = lists:flatten(Text2), ?line ?t:capture_stop(), ?line ok = cover:stop(), ?line ok = cover:import("all_exported"), |