diff options
167 files changed, 3591 insertions, 1502 deletions
diff --git a/.gitignore b/.gitignore index 409be555fb..b35a6c1c31 100644 --- a/.gitignore +++ b/.gitignore @@ -179,6 +179,7 @@ make/win32/ # common_test +/lib/common_test/doc/src/ct_slave.xml /lib/common_test/priv/install.sh # compiler diff --git a/erts/configure.in b/erts/configure.in index 2590357372..31d1d55b8a 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -1793,7 +1793,7 @@ AC_CHECK_FUNCS([getipnodebyname getipnodebyaddr gethostbyname2]) AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ pread pwrite writev memmove strerror strerror_r strncasecmp \ - gethrtime localtime_r gmtime_r mmap mremap memcpy mallopt \ + gethrtime localtime_r gmtime_r inet_pton mmap mremap memcpy mallopt \ sbrk _sbrk __sbrk brk _brk __brk \ flockfile fstat strlcpy strlcat setsid posix2time setlocale nl_langinfo poll]) diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml index 7860d83d83..8bdd154cb9 100644 --- a/erts/doc/src/driver_entry.xml +++ b/erts/doc/src/driver_entry.xml @@ -133,7 +133,7 @@ typedef struct erl_drv_entry { int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen); /* "ioctl" for drivers - invoked by - port_control/3) */ + port_control/3 */ void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */ void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev); /* called when we have output from erlang @@ -146,7 +146,7 @@ typedef struct erl_drv_entry { before 'stop' can be called */ int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen, unsigned int *flags); - /* Works mostly like 'control', a syncronous + /* Works mostly like 'control', a synchronous call into the driver. */ void (*event)(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_data); diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml index 474230cb38..8c3c1e5237 100644 --- a/erts/doc/src/epmd.xml +++ b/erts/doc/src/epmd.xml @@ -116,6 +116,16 @@ <p>These options are available when starting the actual name server. The name server is normally started automatically by the <c>erl</c> command (if not already available), but it can also be started at i.e. system start-up.</p> <taglist> + <tag><c><![CDATA[-address List]]></c></tag> + <item> + <p>Let this instance of <c>epmd</c> listen only on the + comma-separated list of IP addresses and on the loopback address + (which is implicitely added to the list if it has not been + specified). This can also be set using the + <c><![CDATA[ERL_EPMD_ADDRESS]]></c> environment variable, see the + section <seealso marker="#environment_variables">Environment + variables</seealso> below.</p> + </item> <tag><c><![CDATA[-port No]]></c></tag> <item> <p>Let this instance of epmd listen to another TCP port than @@ -228,6 +238,15 @@ <marker id="environment_variables"></marker> <title>Environment variables</title> <taglist> + <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag> + <item> + <p>This environment variable may be set to a comma-separated + list of IP addresses, in which case the <c>epmd</c> daemon + will listen only on the specified address(es) and on the + loopback address (which is implicitely added to the list if it + has not been specified). The default behaviour is to listen on + all available IP addresses.</p> + </item> <tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag> <item> <p>This environment variable can contain the port number epmd will use. diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml index f4c81d9c47..514ee5ffaf 100644 --- a/erts/doc/src/erl.xml +++ b/erts/doc/src/erl.xml @@ -1004,6 +1004,15 @@ add to the code path. See <seealso marker="kernel:code">code(3)</seealso>.</p> </item> + <tag><c><![CDATA[ERL_EPMD_ADDRESS]]></c></tag> + <item> + <p>This environment variable may be set to a comma-separated + list of IP addresses, in which case the + <seealso marker="epmd">epmd</seealso> daemon + will listen only on the specified address(es) and on the + loopback address (which is implicitely added to the list if it + has not been specified).</p> + </item> <tag><c><![CDATA[ERL_EPMD_PORT]]></c></tag> <item> <p>This environment variable can contain the port number to use when diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml index 4bbd4e2a54..cdce4ec0b8 100644 --- a/erts/doc/src/erl_nif.xml +++ b/erts/doc/src/erl_nif.xml @@ -688,6 +688,10 @@ typedef enum { <fsummary>Determine if a term is an empty list</fsummary> <desc><p>Return true if <c>term</c> is an empty list.</p></desc> </func> + <marker id="enif_is_exception"/><func><name><ret>int</ret><nametext>enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> + <fsummary>Determine if a term is an exception</fsummary> + <desc><p>Return true if <c>term</c> is an exception.</p></desc> + </func> <func><name><ret>int</ret><nametext>enif_is_fun(ErlNifEnv* env, ERL_NIF_TERM term)</nametext></name> <fsummary>Determine if a term is a fun</fsummary> <desc><p>Return true if <c>term</c> is a fun.</p></desc> @@ -738,7 +742,14 @@ typedef enum { </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_badarg(ErlNifEnv* env)</nametext></name> <fsummary>Make a badarg exception.</fsummary> - <desc><p>Make a badarg exception to be returned from a NIF.</p></desc> + <desc><p>Make a badarg exception to be returned from a NIF, and set + an associated exception reason in <c>env</c>. If + <c>enif_make_badarg</c> is called, the term it returns <em>must</em> + be returned from the function that called it. No other return value + is allowed. Also, the term returned from <c>enif_make_badarg</c> may + be passed only to + <seealso marker="#enif_is_exception">enif_is_exception</seealso> and + not to any other NIF API function.</p></desc> </func> <func><name><ret>ERL_NIF_TERM</ret><nametext>enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin)</nametext></name> <fsummary>Make a binary term.</fsummary> diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml index 33364c709a..0e828389f6 100644 --- a/erts/doc/src/init.xml +++ b/erts/doc/src/init.xml @@ -67,19 +67,6 @@ </desc> </func> <func> - <name>get_args() -> [Arg]</name> - <fsummary>Get all non-flag command line arguments</fsummary> - <type> - <v>Arg = atom()</v> - </type> - <desc> - <p>Returns any plain command line arguments as a list of atoms - (possibly empty). It is recommended that - <c>get_plain_arguments/1</c> is used instead, because of - the limited length of atoms.</p> - </desc> - </func> - <func> <name>get_argument(Flag) -> {ok, Arg} | error</name> <fsummary>Get the values associated with a command line user flag</fsummary> <type> diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml index 102fa43c1f..f5607945a8 100644 --- a/erts/doc/src/notes.xml +++ b/erts/doc/src/notes.xml @@ -30,6 +30,55 @@ </header> <p>This document describes the changes made to the ERTS application.</p> +<section><title>Erts 5.8.3.2</title> + + <section><title>Known Bugs and Problems</title> + <list> + <item> + <p> + Fix halfword emulator bug in <c>ets:select_delete</c> for + <c>ordered_set</c> that caused emulator to crash.</p> + <p> + Own Id: OTP-9258 Aux Id: seq11836 </p> + </item> + </list> + </section> + +</section> + +<section><title>Erts 5.8.3.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Ets table type ordered_set could order large integer keys + wrongly on pure 64bit platforms. This is now corrected.</p> + <p> + Own Id: OTP-9181</p> + </item> + <item> + <p> + The status of a process was unnecessarily set to waiting + before a process was enqueued in a run queue. This bug + was harmless up until OTP-R14B01. In OTP-R14B02 + <c>erlang:hibernate/3</c> was fixed (OTP-9125). After the + introduction of OTP-9125, the previously harmless process + status bug sometimes caused erroneous badarg exceptions + from <c>process_info()</c>.</p> + <p> + OTP-9125 also introduced a thread unsafe access to the + status field of a process which now also have been fixed.</p> + <p> + *** INCOMPATIBILITY with noxs ***</p> + <p> + Own Id: OTP-9197</p> + </item> + </list> + </section> + +</section> + <section><title>Erts 5.8.3</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c index 6ae9736141..1ca405961f 100644 --- a/erts/emulator/beam/beam_bif_load.c +++ b/erts/emulator/beam/beam_bif_load.c @@ -472,9 +472,6 @@ check_process_code(Process* rp, Module* modp) for (oh = MSO(rp).first; oh; oh = oh->next) { if (thing_subtag(oh->thing_word) == FUN_SUBTAG) { ErlFunThing* funp = (ErlFunThing*) oh; - BeamInstr* fun_code; - - fun_code = funp->fe->address; if (INSIDE((BeamInstr *) funp->fe->address)) { if (done_gc) { diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 8a48049921..fffb172c68 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -291,7 +291,7 @@ dbg_bt(Process* p, Eterm* sp) if (addr) erts_fprintf(stderr, HEXF ": %T:%T/%bpu\n", - addr, (Eterm) addr[0], (Eterm) addr[1], (Uint) addr[2]); + addr, (Eterm) addr[0], (Eterm) addr[1], addr[2]); } sp++; } @@ -484,7 +484,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) if (f+3 != (BeamInstr *) *ap) { erts_print(to, to_arg, "f(" HEXF ")", *ap); } else { - erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]); + erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]); } ap++; } @@ -495,7 +495,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) if (f+3 != (BeamInstr *) *ap) { erts_print(to, to_arg, "p(" HEXF ")", *ap); } else { - erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], (Eterm) f[2]); + erts_print(to, to_arg, "%T:%T/%bpu", (Eterm) f[0], (Eterm) f[1], f[2]); } ap++; } @@ -508,7 +508,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) { Export* ex = (Export *) *ap; erts_print(to, to_arg, - "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], (Uint) ex->code[2]); + "%T:%T/%bpu", (Eterm) ex->code[0], (Eterm) ex->code[1], ex->code[2]); ap++; } break; diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 8991f7b198..32ea8588d2 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -3420,7 +3420,8 @@ void process_main(void) r(0) = c_p->def_arg_reg[0]; x(1) = c_p->def_arg_reg[1]; x(2) = c_p->def_arg_reg[2]; - if (c_p->status == P_WAITING) { + if (c_p->flags & F_HIBERNATE_SCHED) { + c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } Dispatch(); @@ -5225,6 +5226,7 @@ void process_main(void) OpCase(i_hibernate): { SWAPOUT; if (erts_hibernate(c_p, r(0), x(1), x(2), reg)) { + c_p->flags &= ~F_HIBERNATE_SCHED; goto do_schedule; } else { I = handle_error(c_p, I, reg, hibernate_3); @@ -6277,15 +6279,17 @@ erts_hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* re PROCESS_MAIN_CHK_LOCKS(c_p); erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); ASSERT(!ERTS_PROC_IS_EXITING(c_p)); - c_p->status = P_WAITING; #ifdef ERTS_SMP ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); if (c_p->msg.len > 0) erts_add_to_runq(c_p); + else #endif + c_p->status = P_WAITING; } erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); c_p->current = bif_export[BIF_hibernate_3]->code; + c_p->flags |= F_HIBERNATE_SCHED; /* Needed also when woken! */ return 1; } diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index c697b1ef31..57fe25453d 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1411,7 +1411,6 @@ static int load_code(LoaderState* stp) { int i; - int tmp; int ci; int last_func_start = 0; char* sign; @@ -1931,7 +1930,6 @@ load_code(LoaderState* stp) case 'P': /* Byte offset into tuple or stack */ case 'Q': /* Like 'P', but packable */ VerifyTag(stp, tag, TAG_u); - tmp = tmp_op->a[arg].val; code[ci++] = (BeamInstr) ((tmp_op->a[arg].val+1) * sizeof(Eterm)); break; case 'l': /* Floating point register. */ diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c index 19ef356041..b3325d635b 100644 --- a/erts/emulator/beam/bif.c +++ b/erts/emulator/beam/bif.c @@ -368,7 +368,6 @@ static int demonitor(Process *c_p, Eterm ref) ErtsMonitor *mon = NULL; /* The monitor entry to delete */ Process *rp; /* Local target process */ Eterm to = NIL; /* Monitor link traget */ - Eterm ref_p; /* Pid of this end */ DistEntry *dep = NULL; /* Target's distribution entry */ int deref_de = 0; int res; @@ -381,7 +380,6 @@ static int demonitor(Process *c_p, Eterm ref) res = ERTS_DEMONITOR_BADARG; goto done; /* Cannot be this monitor's ref */ } - ref_p = c_p->id; mon = erts_lookup_monitor(c_p->monitors, ref); if (!mon) { diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c index d255cf3558..b8889e6206 100644 --- a/erts/emulator/beam/break.c +++ b/erts/emulator/beam/break.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -266,7 +266,7 @@ print_process_info(int to, void *to_arg, Process *p) } erts_print(to, to_arg, "Number of heap fragments: %d\n", frags); } - erts_print(to, to_arg, "Heap fragment data: %bpu\n", MBUF_SIZE(p)); + erts_print(to, to_arg, "Heap fragment data: %beu\n", MBUF_SIZE(p)); scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); if (scb) { @@ -313,12 +313,11 @@ print_process_info(int to, void *to_arg, Process *p) } /* print the number of reductions etc */ - erts_print(to, to_arg, "Reductions: %bpu\n", p->reds); + erts_print(to, to_arg, "Reductions: %beu\n", p->reds); - erts_print(to, to_arg, "Stack+heap: %bpu\n", p->heap_sz); + erts_print(to, to_arg, "Stack+heap: %beu\n", p->heap_sz); erts_print(to, to_arg, "OldHeap: %bpu\n", - (OLD_HEAP(p) == NULL) ? 0 : - (unsigned)(OLD_HEND(p) - OLD_HEAP(p)) ); + (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HEAP(p)) ); erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop)); erts_print(to, to_arg, "OldHeap unused: %bpu\n", (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HTOP(p)) ); diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c index 243e8973cf..90201f3a90 100644 --- a/erts/emulator/beam/copy.c +++ b/erts/emulator/beam/copy.c @@ -477,7 +477,7 @@ Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) if (htop != hbot) erl_exit(ERTS_ABORT_EXIT, "Internal error in copy_struct() when copying %T:" - " htop=%p != hbot=%p (sz=%bpu)\n", + " htop=%p != hbot=%p (sz=%beu)\n", org_obj, htop, hbot, org_sz); #else if (htop > hbot) { diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c index 044fd045a6..b1cdd0660a 100644 --- a/erts/emulator/beam/dist.c +++ b/erts/emulator/beam/dist.c @@ -904,7 +904,6 @@ int erts_net_message(Port *prt, ErtsDistExternal ede; byte *t; Sint ctl_len; - int orig_ctl_len; Eterm arg; Eterm from, to; Eterm watcher, watched; @@ -985,7 +984,6 @@ int erts_net_message(Port *prt, PURIFY_MSG("data error"); goto data_error; } - orig_ctl_len = ctl_len; if (ctl_len > DIST_CTL_DEFAULT_SIZE) { ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm)); @@ -1689,7 +1687,7 @@ dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) if (size > (Uint) INT_MAX) erl_exit(ERTS_ABORT_EXIT, "Absurdly large distribution output data buffer " - "(%bpu bytes) passed.\n", + "(%beu bytes) passed.\n", size); prt->caller = NIL; @@ -1716,7 +1714,7 @@ dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) if (size > (Uint) INT_MAX) erl_exit(ERTS_ABORT_EXIT, "Absurdly large distribution output data buffer " - "(%bpu bytes) passed.\n", + "(%beu bytes) passed.\n", size); iov[0].iov_base = NULL; diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c index 775f4435a9..673eac7fea 100644 --- a/erts/emulator/beam/erl_alloc.c +++ b/erts/emulator/beam/erl_alloc.c @@ -1913,7 +1913,7 @@ erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) /* Print result... */ erts_print(to, arg, "=memory\n"); for (i = 0; i < length; i++) - erts_print(to, arg, "%T: %bpu\n", atoms[i], *uintps[i]); + erts_print(to, arg, "%T: %beu\n", atoms[i], *uintps[i]); } if (proc) { @@ -2107,11 +2107,11 @@ erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) for (i = 0; i < length; i++) { switch (values[i].arity) { case 2: - erts_print(to, arg, "%s: %bpu\n", + erts_print(to, arg, "%s: %beu\n", values[i].name, values[i].ui[0]); break; case 3: - erts_print(to, arg, "%s: %bpu %bpu\n", + erts_print(to, arg, "%s: %beu %beu\n", values[i].name, values[i].ui[0], values[i].ui[1]); break; default: diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c index 1394b7e829..84c72439a3 100644 --- a/erts/emulator/beam/erl_alloc_util.c +++ b/erts/emulator/beam/erl_alloc_util.c @@ -1877,7 +1877,7 @@ sz_info_carriers(Allctr_t *allctr, cs->blocks.max_ever.size); erts_print(to, arg, - "%scarriers size: %bpu %bpu %bpu\n", + "%scarriers size: %beu %bpu %bpu\n", prefix, curr_size, cs->max.size, @@ -1933,7 +1933,7 @@ info_carriers(Allctr_t *allctr, cs->blocks.max_ever.size); erts_print(to, arg, - "%scarriers: %bpu %bpu %bpu\n", + "%scarriers: %beu %bpu %bpu\n", prefix, curr_no, cs->max.no, @@ -1952,7 +1952,7 @@ info_carriers(Allctr_t *allctr, cs->curr_sys_alloc.no); erts_print(to, arg, - "%scarriers size: %bpu %bpu %bpu\n", + "%scarriers size: %beu %bpu %bpu\n", prefix, curr_size, cs->max.size, @@ -2053,15 +2053,15 @@ info_calls(Allctr_t *allctr, #define PRINT_CC_4(TO, TOA, NAME, CC) \ if ((CC).giga_no == 0) \ - erts_print(TO, TOA, "%s calls: %bpu\n", NAME, CC.no); \ + erts_print(TO, TOA, "%s calls: %b32u\n", NAME, CC.no); \ else \ - erts_print(TO, TOA, "%s calls: %bpu%09lu\n", NAME, CC.giga_no, CC.no) + erts_print(TO, TOA, "%s calls: %b32u%09lu\n", NAME, CC.giga_no, CC.no) #define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \ if ((CC).giga_no == 0) \ - erts_print(TO, TOA, "%s%s calls: %bpu\n",PRFX,NAME,CC.no); \ + erts_print(TO, TOA, "%s%s calls: %b32u\n",PRFX,NAME,CC.no); \ else \ - erts_print(TO, TOA, "%s%s calls: %bpu%09lu\n",PRFX,NAME,CC.giga_no,CC.no) + erts_print(TO, TOA, "%s%s calls: %b32u%09lu\n",PRFX,NAME,CC.giga_no,CC.no) char *prefix = allctr->name_prefix; int to = *print_to_p; @@ -2168,21 +2168,21 @@ info_options(Allctr_t *allctr, "option e: true\n" "option t: %s\n" "option ramv: %s\n" - "option sbct: %bpu\n" + "option sbct: %beu\n" #if HAVE_ERTS_MSEG "option asbcst: %bpu\n" "option rsbcst: %bpu\n" #endif - "option rsbcmt: %bpu\n" - "option rmbcmt: %bpu\n" - "option mmbcs: %bpu\n" + "option rsbcmt: %beu\n" + "option rmbcmt: %beu\n" + "option mmbcs: %beu\n" #if HAVE_ERTS_MSEG - "option mmsbc: %bpu\n" - "option mmmbc: %bpu\n" + "option mmsbc: %beu\n" + "option mmmbc: %beu\n" #endif - "option lmbcs: %bpu\n" - "option smbcs: %bpu\n" - "option mbcgs: %bpu\n", + "option lmbcs: %beu\n" + "option smbcs: %beu\n" + "option mbcgs: %beu\n", topt, allctr->ramv ? "true" : "false", allctr->sbc_threshold, @@ -2292,9 +2292,9 @@ erts_alcu_au_info_options(int *print_to_p, void *print_to_arg, erts_print(*print_to_p, print_to_arg, #if HAVE_ERTS_MSEG - "option mmc: %bpu\n" + "option mmc: %beu\n" #endif - "option ycs: %bpu\n", + "option ycs: %beu\n", #if HAVE_ERTS_MSEG max_mseg_carriers, #endif diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c index 71206c48b2..e50fc18e64 100644 --- a/erts/emulator/beam/erl_bif_info.c +++ b/erts/emulator/beam/erl_bif_info.c @@ -71,9 +71,9 @@ static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE #endif #endif #ifdef ERTS_SMP - " [smp:%bpu:%bpu]" + " [smp:%beu:%beu]" #endif - " [rq:%bpu]" + " [rq:%beu]" #ifdef USE_THREADS " [async-threads:%d]" #endif diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c index 6f8a7436d5..0174e5fc43 100644 --- a/erts/emulator/beam/erl_bits.c +++ b/erts/emulator/beam/erl_bits.c @@ -177,7 +177,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff byte* LSB; byte* MSB; Uint* hp; - Uint* hp_end; Uint words_needed; Uint actual; Uint v32; @@ -405,7 +404,6 @@ erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuff default: words_needed = 1+WSIZE(bytes); hp = HeapOnlyAlloc(p, words_needed); - hp_end = hp + words_needed; res = bytes_to_big(LSB, bytes, sgn, hp); if (is_small(res)) { p->htop = hp; @@ -425,7 +423,6 @@ Eterm erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) { ErlSubBin* sb; - size_t num_bytes; /* Number of bytes in binary. */ if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ return THE_NON_VALUE; @@ -435,7 +432,6 @@ erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffe * From now on, we can't fail. */ - num_bytes = NBYTES(num_bits); sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE); sb->thing_word = HEADER_SUB_BIN; @@ -1557,7 +1553,6 @@ Uint32 erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb) { Uint bytes; - Uint bits; Uint offs; byte bigbuf[4]; byte* LSB; @@ -1567,7 +1562,6 @@ erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb) ASSERT(mb->size - mb->offset >= 32); bytes = 4; - bits = 8; offs = 0; LSB = bigbuf; diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 61e8a595be..e0a6aa05c6 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -3737,7 +3737,7 @@ static void print_table(int to, void *to_arg, int show, DbTable* tb) erts_print(to, to_arg, "Objects: %d\n", (int)erts_smp_atomic_read(&tb->common.nitems)); erts_print(to, to_arg, "Words: %bpu\n", - (Uint) ((erts_smp_atomic_read(&tb->common.memory_size) + (UWord) ((erts_smp_atomic_read(&tb->common.memory_size) + sizeof(Uint) - 1) / sizeof(Uint))); diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c index 6cdbec3213..a59c0c258d 100644 --- a/erts/emulator/beam/erl_db_tree.c +++ b/erts/emulator/beam/erl_db_tree.c @@ -575,7 +575,7 @@ static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) return DB_ERROR_NONE; } -static ERTS_INLINE int cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, +static ERTS_INLINE Sint cmp_key(DbTableTree* tb, Eterm key, Eterm* key_base, TreeDbTerm* obj) { return cmp_rel(key, key_base, diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c index 0b63ab9ba0..c3b074f782 100644 --- a/erts/emulator/beam/erl_db_util.c +++ b/erts/emulator/beam/erl_db_util.c @@ -5046,31 +5046,31 @@ void db_match_dis(Binary *bp) ++t; n = *t; ++t; - erts_printf("TryMeElse\t%bpu\n", n); + erts_printf("TryMeElse\t%beu\n", n); break; case matchArray: ++t; n = *t; ++t; - erts_printf("Array\t%bpu\n", n); + erts_printf("Array\t%beu\n", n); break; case matchArrayBind: ++t; n = *t; ++t; - erts_printf("ArrayBind\t%bpu\n", n); + erts_printf("ArrayBind\t%beu\n", n); break; case matchTuple: ++t; n = *t; ++t; - erts_printf("Tuple\t%bpu\n", n); + erts_printf("Tuple\t%beu\n", n); break; case matchPushT: ++t; n = *t; ++t; - erts_printf("PushT\t%bpu\n", n); + erts_printf("PushT\t%beu\n", n); break; case matchPushL: ++t; @@ -5084,13 +5084,13 @@ void db_match_dis(Binary *bp) ++t; n = *t; ++t; - erts_printf("Bind\t%bpu\n", n); + erts_printf("Bind\t%beu\n", n); break; case matchCmp: ++t; n = *t; ++t; - erts_printf("Cmp\t%bpu\n", n); + erts_printf("Cmp\t%beu\n", n); break; case matchEqBin: ++t; @@ -5112,9 +5112,9 @@ void db_match_dis(Binary *bp) else erts_printf(", "); #if defined(ARCH_64) && !HALFWORD_HEAP - erts_printf("0x%016bpx", rt->data.ui[ri]); + erts_printf("0x%016bex", rt->data.ui[ri]); #else - erts_printf("0x%08bpx", rt->data.ui[ri]); + erts_printf("0x%08bex", rt->data.ui[ri]); #endif } } @@ -5136,9 +5136,9 @@ void db_match_dis(Binary *bp) else erts_printf(", "); #if defined(ARCH_64) && !HALFWORD_HEAP - erts_printf("0x%016bpx", *et); + erts_printf("0x%016bex", *et); #else - erts_printf("0x%08bpx", *et); + erts_printf("0x%08bex", *et); #endif ++et; } @@ -5190,31 +5190,31 @@ void db_match_dis(Binary *bp) ++t; n = *t; ++t; - erts_printf("MkTuple\t%bpu\n", n); + erts_printf("MkTuple\t%beu\n", n); break; case matchOr: ++t; n = *t; ++t; - erts_printf("Or\t%bpu\n", n); + erts_printf("Or\t%beu\n", n); break; case matchAnd: ++t; n = *t; ++t; - erts_printf("And\t%bpu\n", n); + erts_printf("And\t%beu\n", n); break; case matchOrElse: ++t; n = *t; ++t; - erts_printf("OrElse\t%bpu\n", n); + erts_printf("OrElse\t%beu\n", n); break; case matchAndAlso: ++t; n = *t; ++t; - erts_printf("AndAlso\t%bpu\n", n); + erts_printf("AndAlso\t%beu\n", n); break; case matchCall0: ++t; @@ -5244,19 +5244,19 @@ void db_match_dis(Binary *bp) ++t; n = (Uint) *t; ++t; - erts_printf("PushV\t%bpu\n", n); + erts_printf("PushV\t%beu\n", n); break; #if HALFWORD_HEAP case matchPushVGuard: n = (Uint) *++t; ++t; - erts_printf("PushVGuard\t%bpu\n", n); + erts_printf("PushVGuard\t%beu\n", n); break; #endif case matchPushVResult: n = (Uint) *++t; ++t; - erts_printf("PushVResult\t%bpu\n", n); + erts_printf("PushVResult\t%beu\n", n); break; case matchTrue: ++t; @@ -5367,8 +5367,8 @@ void db_match_dis(Binary *bp) } erts_printf("}\n"); erts_printf("num_bindings: %d\n", prog->num_bindings); - erts_printf("heap_size: %bpu\n", prog->heap_size); - erts_printf("stack_offset: %bpu\n", prog->stack_offset); + erts_printf("heap_size: %beu\n", prog->heap_size); + erts_printf("stack_offset: %beu\n", prog->stack_offset); erts_printf("text: 0x%08x\n", (unsigned long) prog->text); erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset); diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h index 3c0eade0d8..069b71ab0d 100644 --- a/erts/emulator/beam/erl_driver.h +++ b/erts/emulator/beam/erl_driver.h @@ -294,7 +294,7 @@ typedef struct erl_drv_entry { int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen); /* "ioctl" for drivers - invoked by - port_control/3) */ + port_control/3 */ void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */ void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev); /* called when we have output from erlang @@ -307,7 +307,7 @@ typedef struct erl_drv_entry { before 'stop' can be called */ int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen, unsigned int *flags); - /* Works mostly like 'control', a syncronous + /* Works mostly like 'control', a synchronous call into the driver. */ void (*event)(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_data); diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c index 735986ba54..5edcd667e7 100644 --- a/erts/emulator/beam/erl_gc.c +++ b/erts/emulator/beam/erl_gc.c @@ -455,7 +455,6 @@ erts_garbage_collect_hibernate(Process* p) Eterm* heap; Eterm* htop; Rootset rootset; - int n; char* src; Uint src_size; Uint actual_size; @@ -486,7 +485,7 @@ erts_garbage_collect_hibernate(Process* p) sizeof(Eterm)*heap_size); htop = heap; - n = setup_rootset(p, p->arg_reg, p->arity, &rootset); + (void) setup_rootset(p, p->arg_reg, p->arity, &rootset); #if HIPE hipe_empty_nstack(p); #endif diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index 135c6b0ccc..8b48444904 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -430,6 +430,11 @@ int enif_is_list(ErlNifEnv* env, ERL_NIF_TERM term) return is_list(term) || is_nil(term); } +int enif_is_exception(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return term == THE_NON_VALUE; +} + static void aligned_binary_dtor(struct enif_tmp_obj_t* obj) { erts_free_aligned_binary_bytes_extra((byte*)obj,ERTS_ALC_T_TMP); diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h index 8050b3640a..d028567faf 100644 --- a/erts/emulator/beam/erl_nif.h +++ b/erts/emulator/beam/erl_nif.h @@ -31,9 +31,10 @@ ** 1.0: R13B04 ** 2.0: R14A ** 2.1: R14B02 "vm_variant" +** 2.2: R14B03 enif_is_exception */ #define ERL_NIF_MAJOR_VERSION 2 -#define ERL_NIF_MINOR_VERSION 1 +#define ERL_NIF_MINOR_VERSION 2 #include <stdlib.h> diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h index eca506593d..c991b61abe 100644 --- a/erts/emulator/beam/erl_nif_api_funcs.h +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -21,6 +21,13 @@ # error This file should not be included directly #endif +/* +** WARNING: add new ERL_NIF_API_FUNC_DECL entries at the bottom of the list +** to keep compatibility on Windows!!! +** +** And don't forget to increase ERL_NIF_MINOR_VERSION in erl_nif.h +** when adding functions to the API. +*/ #ifdef ERL_NIF_API_FUNC_DECL ERL_NIF_API_FUNC_DECL(void*,enif_priv_data,(ErlNifEnv*)); ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(size_t size)); @@ -128,12 +135,17 @@ ERL_NIF_API_FUNC_DECL(int,enif_get_uint64,(ErlNifEnv*, ERL_NIF_TERM term, ErlNif ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int64,(ErlNifEnv*, ErlNifSInt64)); ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); #endif +ERL_NIF_API_FUNC_DECL(int,enif_is_exception,(ErlNifEnv*, ERL_NIF_TERM term)); /* -** Add last to keep compatibility on Windows!!! +** Add new entries here to keep compatibility on Windows!!! */ #endif +/* +** Please keep the ERL_NIF_API_FUNC_MACRO list below in the same order +** as the ERL_NIF_API_FUNC_DECL list above +*/ #ifdef ERL_NIF_API_FUNC_MACRO # define enif_priv_data ERL_NIF_API_FUNC_MACRO(enif_priv_data) # define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc) @@ -243,6 +255,11 @@ ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_uint64,(ErlNifEnv*, ErlNifUInt64)); # define enif_make_uint64 ERL_NIF_API_FUNC_MACRO(enif_make_uint64) #endif +# define enif_is_exception ERL_NIF_API_FUNC_MACRO(enif_is_exception) + +/* +** Add new entries here +*/ #endif #ifndef enif_make_list1 diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c index f8997f3c07..31f23d3978 100644 --- a/erts/emulator/beam/erl_process.c +++ b/erts/emulator/beam/erl_process.c @@ -1267,7 +1267,6 @@ ssi_flags_set_wake(ErtsSchedulerSleepInfo *ssi) static void wake_scheduler(ErtsRunQueue *rq, int incq, int one) { - int res; ErtsSchedulerSleepInfo *ssi; ErtsSchedulerSleepList *sl; @@ -1298,7 +1297,6 @@ wake_scheduler(ErtsRunQueue *rq, int incq, int one) if (ssi->next) ssi->next->prev = ssi->prev; - res = sl->list != NULL; erts_smp_spin_unlock(&sl->lock); ERTS_THR_MEMORY_BARRIER; @@ -2857,7 +2855,6 @@ resume_process(Process *p) return; switch(p->rstatus) { case P_RUNABLE: - *statusp = P_WAITING; /* make erts_add_to_runq work */ erts_add_to_runq(p); break; case P_WAITING: @@ -3668,7 +3665,7 @@ sched_thread_func(void *vesdp) #ifdef ERTS_ENABLE_LOCK_CHECK { char buf[31]; - erts_snprintf(&buf[0], 31, "scheduler %bpu", no); + erts_snprintf(&buf[0], 31, "scheduler %beu", no); erts_lc_set_thread_name(&buf[0]); } #endif @@ -3726,7 +3723,7 @@ sched_thread_func(void *vesdp) process_main(); /* No schedulers should *ever* terminate */ - erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n", + erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %beu terminated\n", ((ErtsSchedulerData *) vesdp)->no); return NULL; } @@ -3775,8 +3772,8 @@ erts_start_schedulers(void) erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); ASSERT(actual != wanted_no_schedulers); erts_dsprintf(dsbufp, - "Failed to create %bpu scheduler-threads (%s:%d); " - "only %bpu scheduler-thread%s created.\n", + "Failed to create %beu scheduler-threads (%s:%d); " + "only %beu scheduler-thread%s created.\n", wanted_no_schedulers, erl_errno_id(res), res, actual, actual == 1 ? " was" : "s were"); erts_send_error_to_logger_nogl(dsbufp); @@ -4653,7 +4650,7 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p) if (p->status_flags & ERTS_PROC_SFLG_INRUNQ) return NULL; else if (p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) { - ASSERT(p->status != P_SUSPENDED); + ASSERT(p->rcount == 0); ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p); p->status_flags |= ERTS_PROC_SFLG_PENDADD2SCHEDQ; return NULL; @@ -4664,9 +4661,8 @@ internal_add_to_runq(ErtsRunQueue *runq, Process *p) ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p); #ifndef ERTS_SMP /* Never schedule a suspended process (ok in smp case) */ - ASSERT(p->status != P_SUSPENDED); + ASSERT(p->rcount == 0); add_runq = runq; - #else ASSERT(!p->bound_runq || p->bound_runq == p->run_queue); if (p->bound_runq) { @@ -5166,7 +5162,7 @@ Process *schedule(Process *p, int calls) handle_pending_suspend(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); ASSERT(!(p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ) - || p->status != P_SUSPENDED); + || p->rcount == 0); } #endif erts_smp_runq_lock(rq); @@ -7611,10 +7607,28 @@ timeout_proc(Process* p) p->flags |= F_TIMO; p->flags &= ~F_INSLPQUEUE; - if (p->status == P_WAITING) - erts_add_to_runq(p); - if (p->status == P_SUSPENDED) + switch (p->status) { + case P_GARBING: + switch (p->gcstatus) { + case P_SUSPENDED: + goto suspended; + case P_WAITING: + goto waiting; + default: + break; + } + break; + case P_WAITING: + waiting: + erts_add_to_runq(p); + break; + case P_SUSPENDED: + suspended: p->rstatus = P_RUNABLE; /* MUST set resume status to runnable */ + break; + default: + break; + } } diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h index 8f78a7d76e..334ae5573f 100644 --- a/erts/emulator/beam/erl_process.h +++ b/erts/emulator/beam/erl_process.h @@ -895,6 +895,7 @@ extern struct erts_system_profile_flags_t erts_system_profile_flags; #define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */ #define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ #define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ +#define F_HIBERNATE_SCHED (1 << 11) /* Schedule out after hibernate op */ /* process trace_flags */ #define F_SENSITIVE (1 << 0) diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c index 68fda01597..5410bcd495 100644 --- a/erts/emulator/beam/erl_process_dump.c +++ b/erts/emulator/beam/erl_process_dump.c @@ -194,7 +194,7 @@ dump_element(int to, void *to_arg, Eterm x) } else if (is_pid(x)) { erts_print(to, to_arg, "P%T", x); } else if (is_port(x)) { - erts_print(to, to_arg, "p<%bpu.%bpu>", + erts_print(to, to_arg, "p<%beu.%beu>", port_channel_no(x), port_number(x)); } else if (is_nil(x)) { erts_putc(to, to_arg, 'N'); @@ -376,7 +376,7 @@ heap_dump(int to, void *to_arg, Eterm x) erts_print(to, to_arg, "P%T\n", x); *ptr = OUR_NIL; } else if (is_external_port_header(hdr)) { - erts_print(to, to_arg, "p<%bpu.%bpu>\n", + erts_print(to, to_arg, "p<%beu.%beu>\n", port_channel_no(x), port_number(x)); *ptr = OUR_NIL; } else { diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c index 545b345a71..dacf228e92 100644 --- a/erts/emulator/beam/erl_unicode.c +++ b/erts/emulator/beam/erl_unicode.c @@ -902,7 +902,6 @@ static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos, static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3) { Eterm *real_bin; - Sint need; byte* bytes; Eterm rest_term; int left, sleft; @@ -918,7 +917,6 @@ static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3) ASSERT(is_binary(BIF_ARG_1)); real_bin = binary_val(BIF_ARG_1); ASSERT(*real_bin == HEADER_PROC_BIN); - need = ((ProcBin *) real_bin)->val->orig_size; pos = (int) binary_size(BIF_ARG_1); bytes = binary_bytes(BIF_ARG_1); sleft = left = allowed_iterations(BIF_P); diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index 432bdd705b..96da894d90 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1828,7 +1828,7 @@ erts_alloc_message_heap(Uint size, #endif if (size > (Uint) INT_MAX) - erl_exit(ERTS_ABORT_EXIT, "HUGE size (%bpu)\n", size); + erl_exit(ERTS_ABORT_EXIT, "HUGE size (%beu)\n", size); if ( #if defined(ERTS_SMP) diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c index f21a96c754..f619c6f88b 100644 --- a/erts/emulator/beam/io.c +++ b/erts/emulator/beam/io.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2010. All Rights Reserved. + * Copyright Ericsson AB 1996-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -1226,7 +1226,6 @@ void init_io(void) { int i; ErlDrvEntry** dp; - ErlDrvEntry* drv; char maxports[21]; /* enough for any 64-bit integer */ size_t maxportssize = sizeof(maxports); Uint ports_bits = ERTS_PORTS_BITS; @@ -1309,10 +1308,8 @@ void init_io(void) init_driver(&fd_driver, &fd_driver_entry, NULL); init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); init_driver(&spawn_driver, &spawn_driver_entry, NULL); - for (dp = driver_tab; *dp != NULL; dp++) { - drv = *dp; + for (dp = driver_tab; *dp != NULL; dp++) erts_add_driver_entry(*dp, NULL, 1); - } erts_smp_tsd_set(driver_list_lock_status_key, NULL); erts_smp_mtx_unlock(&erts_driver_list_lock); @@ -2420,7 +2417,7 @@ void erts_raw_port_command(Port* p, byte* buf, Uint len) if (len > (Uint) INT_MAX) erl_exit(ERTS_ABORT_EXIT, - "Absurdly large data buffer (%bpu bytes) passed to" + "Absurdly large data buffer (%beu bytes) passed to" "output callback of %s driver.\n", len, p->drv_ptr->name ? p->drv_ptr->name : "unknown"); @@ -3670,7 +3667,7 @@ driver_pdl_inc_refc(ErlDrvPDL pdl) { ErlDrvSInt refc = pdl_inctest_refc(pdl); #ifdef HARDDEBUG - erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bpd\r\n", + erts_fprintf(stderr, "driver_pdl_inc_refc(%p) -> %bed\r\n", pdl, refc); #endif return refc; diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c index f531d1430b..6b4f3b3b36 100644 --- a/erts/emulator/beam/utils.c +++ b/erts/emulator/beam/utils.c @@ -2705,7 +2705,7 @@ term_array: /* arrays in 'aa' and 'bb', length in 'i' */ while (--i) { a = *aa++; b = *bb++; - if (a != b) { + if (!is_same(a,a_base, b,b_base)) { if (is_atom(a) && is_atom(b)) { if ((j = cmp_atoms(a, b)) != 0) { goto not_equal; diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c index 4e9b5005c1..f0ff3f54c5 100644 --- a/erts/emulator/drivers/common/efile_drv.c +++ b/erts/emulator/drivers/common/efile_drv.c @@ -410,7 +410,7 @@ struct t_data static void *ef_safe_alloc(Uint s) { void *p = EF_ALLOC(s); - if (!p) erl_exit(1, "efile drv: Can't allocate %d bytes of memory\n", s); + if (!p) erl_exit(1, "efile drv: Can't allocate %lu bytes of memory\n", (unsigned long)s); return p; } diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c index 5531a275ea..741cb6ae20 100644 --- a/erts/emulator/drivers/common/gzio.c +++ b/erts/emulator/drivers/common/gzio.c @@ -632,6 +632,7 @@ erts_gzseek(gzFile file, int offset, int whence) while (s->position < pos) { char buf[512]; int n; + int save_pos = s->position; n = pos - s->position; if (n > sizeof(buf)) @@ -643,6 +644,7 @@ erts_gzseek(gzFile file, int offset, int whence) memset(buf, '\0', n); erts_gzwrite(file, buf, n); } + if (save_pos == s->position) break; } return s->position; diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c index c7b608aafe..7ca11f8c6c 100644 --- a/erts/emulator/hipe/hipe_debug.c +++ b/erts/emulator/hipe/hipe_debug.c @@ -51,7 +51,7 @@ static const char stars[2*sizeof(long)+5] = { extern Uint beam_apply[]; -static void print_beam_pc(Uint *pc) +static void print_beam_pc(BeamInstr *pc) { if (pc == hipe_beam_pc_return) { printf("return-to-native"); @@ -60,7 +60,7 @@ static void print_beam_pc(Uint *pc) } else if (pc == &beam_apply[1]) { printf("normal-process-exit"); } else { - Eterm *mfa = find_function_from_pc(pc); + BeamInstr *mfa = find_function_from_pc(pc); if (mfa) erts_printf("%T:%T/%bpu + 0x%bpx", mfa[0], mfa[1], mfa[2], pc - &mfa[3]); @@ -71,7 +71,7 @@ static void print_beam_pc(Uint *pc) static void catch_slot(Eterm *pos, Eterm val) { - Uint *pc = catch_pc(val); + BeamInstr *pc = catch_pc(val); printf(" | 0x%0*lx | 0x%0*lx | CATCH 0x%0*lx (BEAM ", 2*(int)sizeof(long), (unsigned long)pos, 2*(int)sizeof(long), (unsigned long)val, diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c index ceb290b644..ffa3a6328c 100644 --- a/erts/emulator/sys/common/erl_mseg.c +++ b/erts/emulator/sys/common/erl_mseg.c @@ -1092,10 +1092,10 @@ info_options(char *prefix, if (print_to_p) { int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "%samcbf: %bpu\n", prefix, abs_max_cache_bad_fit); - erts_print(to, arg, "%srmcbf: %bpu\n", prefix, rel_max_cache_bad_fit); - erts_print(to, arg, "%smcs: %bpu\n", prefix, max_cache_size); - erts_print(to, arg, "%scci: %bpu\n", prefix, cache_check_interval); + erts_print(to, arg, "%samcbf: %beu\n", prefix, abs_max_cache_bad_fit); + erts_print(to, arg, "%srmcbf: %beu\n", prefix, rel_max_cache_bad_fit); + erts_print(to, arg, "%smcs: %beu\n", prefix, max_cache_size); + erts_print(to, arg, "%scci: %beu\n", prefix, cache_check_interval); } if (hpp || szp) { @@ -1131,9 +1131,9 @@ info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) #define PRINT_CC(TO, TOA, CC) \ if (calls.CC.giga_no == 0) \ - erts_print(TO, TOA, "mseg_%s calls: %bpu\n", #CC, calls.CC.no); \ + erts_print(TO, TOA, "mseg_%s calls: %b32u\n", #CC, calls.CC.no); \ else \ - erts_print(TO, TOA, "mseg_%s calls: %bpu%09bpu\n", #CC, \ + erts_print(TO, TOA, "mseg_%s calls: %b32u%09b32u\n", #CC, \ calls.CC.giga_no, calls.CC.no) int to = *print_to_p; @@ -1215,13 +1215,13 @@ info_status(MemKind* mk, int *print_to_p, void *print_to_arg, int to = *print_to_p; void *arg = print_to_arg; - erts_print(to, arg, "cached_segments: %bpu\n", mk->cache_size); - erts_print(to, arg, "cache_hits: %bpu\n", mk->cache_hits); - erts_print(to, arg, "segments: %bpu %bpu %bpu\n", + erts_print(to, arg, "cached_segments: %beu\n", mk->cache_size); + erts_print(to, arg, "cache_hits: %beu\n", mk->cache_hits); + erts_print(to, arg, "segments: %beu %beu %beu\n", mk->segments.current.no, mk->segments.max.no, mk->segments.max_ever.no); - erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n", + erts_print(to, arg, "segments_size: %beu %beu %beu\n", mk->segments.current.sz, mk->segments.max.sz, mk->segments.max_ever.sz); - erts_print(to, arg, "segments_watermark: %bpu\n", + erts_print(to, arg, "segments_watermark: %beu\n", mk->segments.current.watermark); } @@ -1507,7 +1507,7 @@ erts_mseg_init(ErtsMsegInit_t *init) while ((page_size >> page_shift) != 1) { if ((page_size & (1 << (page_shift - 1))) != 0) erl_exit(ERTS_ABORT_EXIT, - "erts_mseg: Unexpected page_size %bpu\n", page_size); + "erts_mseg: Unexpected page_size %beu\n", page_size); page_shift++; } diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl index 703a00a598..c1a048be75 100644 --- a/erts/emulator/test/code_SUITE.erl +++ b/erts/emulator/test/code_SUITE.erl @@ -483,7 +483,7 @@ do_false_dependency(Init, Code) -> %% Spawn process. Make sure it has the appropriate init function %% and returned. CP should not contain garbage after the return. Parent = self(), - ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init) end), + ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init, true) end), ?line receive initialized -> ok end, %% Reload the module. Make sure the process is still alive. @@ -501,11 +501,18 @@ do_false_dependency(Init, Code) -> ?line true = erlang:purge_module(cpbugx), ok. -false_dependency_loop(Parent, Init) -> +false_dependency_loop(Parent, Init, SendInitAck) -> Init(), - Parent ! initialized, + case SendInitAck of + true -> Parent ! initialized; + false -> void + %% Just send one init-ack. I guess the point of this test + %% wasn't to fill parents msg-queue (?). Seen to cause + %% out-of-mem (on halfword-vm for some reason) by + %% 91 million msg in queue. /sverker + end, receive - _ -> false_dependency_loop(Parent, Init) + _ -> false_dependency_loop(Parent, Init, false) end. coverage(Config) when is_list(Config) -> diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index b79c30d8d9..91d695d979 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -1121,7 +1121,14 @@ is_checks(Config) when is_list(Config) -> ?line ensure_lib_loaded(Config, 1), ?line ok = check_is(hejsan, <<19,98>>, make_ref(), ok, fun() -> ok end, self(), hd(erlang:ports()), [], [1,9,9,8], - {hejsan, "hejsan", [$h,"ejs",<<"an">>]}). + {hejsan, "hejsan", [$h,"ejs",<<"an">>]}), + try + ?line error = check_is_exception(), + ?line throw(expected_badarg) + catch + error:badarg -> + ?line ok + end. get_length(doc) -> ["Test all enif_get_length functions"]; get_length(Config) when is_list(Config) -> @@ -1245,6 +1252,7 @@ release_resource(_) -> ?nif_stub. last_resource_dtor_call() -> ?nif_stub. make_new_resource(_,_) -> ?nif_stub. check_is(_,_,_,_,_,_,_,_,_,_) -> ?nif_stub. +check_is_exception() -> ?nif_stub. length_test(_,_,_,_,_) -> ?nif_stub. make_atoms() -> ?nif_stub. make_strings() -> ?nif_stub. diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index 8489124966..dc047394b5 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -802,6 +802,23 @@ static ERL_NIF_TERM check_is(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] } /* + * no arguments + * + * This function is separate from check_is because it calls enif_make_badarg + * and so it must return the badarg exception as its return value. Thus, the + * badarg exception indicates success. Failure is indicated by returning an + * error atom. + */ +static ERL_NIF_TERM check_is_exception(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{ + ERL_NIF_TERM error_atom = enif_make_atom(env, "error"); + ERL_NIF_TERM badarg = enif_make_badarg(env); + if (enif_is_exception(env, error_atom)) return error_atom; + if (!enif_is_exception(env, badarg)) return error_atom; + return badarg; +} + +/* * argv[0] atom with length of 6 * argv[1] list with length of 6 * argv[2] empty list @@ -1383,6 +1400,7 @@ static ErlNifFunc nif_funcs[] = {"last_resource_dtor_call", 0, last_resource_dtor_call}, {"make_new_resource", 2, make_new_resource}, {"check_is", 10, check_is}, + {"check_is_exception", 0, check_is_exception}, {"length_test", 5, length_test}, {"make_atoms", 0, make_atoms}, {"make_strings", 0, make_strings}, diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl index a731f09e4c..36bae908aa 100644 --- a/erts/emulator/test/process_SUITE.erl +++ b/erts/emulator/test/process_SUITE.erl @@ -39,6 +39,7 @@ process_info_other_dist_msg/1, process_info_2_list/1, process_info_lock_reschedule/1, process_info_lock_reschedule2/1, + process_info_lock_reschedule3/1, bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, process_status_exiting/1, otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, @@ -65,7 +66,8 @@ all() -> t_process_info, process_info_other_msg, process_info_other_dist_msg, process_info_2_list, process_info_lock_reschedule, - process_info_lock_reschedule2, process_status_exiting, + process_info_lock_reschedule2, + process_info_lock_reschedule3, process_status_exiting, bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, garbage_collect, process_info_messages, process_flag_badarg, process_flag_heap_size, @@ -702,6 +704,52 @@ process_info_lock_reschedule2(Config) when is_list(Config) -> ?line unlink(P6), exit(P6, bang), ?line ok. +many_args(0,_B,_C,_D,_E,_F,_G,_H,_I,_J) -> + ok; +many_args(A,B,C,D,E,F,G,H,I,J) -> + many_args(A-1,B,C,D,E,F,G,H,I,J). + +do_pi_msg_len(PT, AT) -> + lists:map(fun (_) -> ok end, [a,b,c,d]), + {message_queue_len, _} = process_info(element(2,PT), element(2,AT)). + +process_info_lock_reschedule3(doc) -> + []; +process_info_lock_reschedule3(suite) -> + []; +process_info_lock_reschedule3(Config) when is_list(Config) -> + %% We need a process that is running and an item that requires + %% process_info to take the main process lock. + ?line Target1 = spawn_link(fun tok_loop/0), + ?line Name1 = process_info_lock_reschedule_running, + ?line register(Name1, Target1), + ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end), + ?line Name2 = process_info_lock_reschedule_waiting, + ?line register(Name2, Target2), + ?line PI = fun(N) -> + case N rem 10 of + 0 -> erlang:yield(); + _ -> ok + end, + ?line do_pi_msg_len({proc, Target1}, + {arg, message_queue_len}) + end, + ?line many_args(100000,1,2,3,4,5,6,7,8,9), + ?line lists:foreach(PI, lists:seq(1,1000000)), + %% Make sure Target1 still is willing to "tok loop" + ?line case process_info(Target1, status) of + {status, OkStatus} when OkStatus == runnable; + OkStatus == running; + OkStatus == garbage_collecting -> + ?line unlink(Target1), + ?line unlink(Target2), + ?line exit(Target1, bang), + ?line exit(Target2, bang), + ?line OkStatus; + {status, BadStatus} -> + ?line ?t:fail(BadStatus) + end. + process_status_exiting(Config) when is_list(Config) -> %% Make sure that erts_debug:get_internal_state({process_status,P}) %% returns exiting if it is in status P_EXITING. diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c index e94533f0ba..a1f202251c 100644 --- a/erts/epmd/src/epmd.c +++ b/erts/epmd/src/epmd.c @@ -33,6 +33,7 @@ static void usage(EpmdVars *); static void run_daemon(EpmdVars*); +static char* get_addresses(void); static int get_port_no(void); static int check_relaxed(void); #ifdef __WIN32__ @@ -133,6 +134,7 @@ int main(int argc, char** argv) { EpmdVars g_empd_vars; EpmdVars *g = &g_empd_vars; + int i; #ifdef __WIN32__ WORD wVersionRequested; WSADATA wsaData; @@ -158,8 +160,9 @@ int main(int argc, char** argv) g->argv = NULL; #endif - g->port = get_port_no(); - g->debug = 0; + g->addresses = get_addresses(); + g->port = get_port_no(); + g->debug = 0; g->silent = 0; g->is_daemon = 0; @@ -168,12 +171,14 @@ int main(int argc, char** argv) g->delay_accept = 0; g->delay_write = 0; g->progname = argv[0]; - g->listenfd = -1; g->conn = NULL; g->nodes.reg = g->nodes.unreg = g->nodes.unreg_tail = NULL; g->nodes.unreg_count = 0; g->active_conn = 0; + for (i = 0; i < MAX_LISTEN_SOCKETS; i++) + g->listenfd[i] = -1; + argc--; argv++; while (argc > 0) { @@ -208,6 +213,11 @@ int main(int argc, char** argv) else usage(g); epmd_cleanup_exit(g,0); + } else if (strcmp(argv[0], "-address") == 0) { + if (argc == 1) + usage(g); + g->addresses = argv[1]; + argv += 2; argc -= 2; } else if (strcmp(argv[0], "-port") == 0) { if ((argc == 1) || ((g->port = atoi(argv[1])) == 0)) @@ -252,13 +262,10 @@ int main(int argc, char** argv) /* * max_conn must not be greater than FD_SETSIZE. * (at least QNX crashes) - * - * More correctly, it must be FD_SETSIZE - 1, beacuse the - * listen FD is stored outside the connection array. */ if (g->max_conn > FD_SETSIZE) { - g->max_conn = FD_SETSIZE - 1; + g->max_conn = FD_SETSIZE; } if (g->is_daemon) { @@ -393,11 +400,14 @@ static void run_daemon(EpmdVars *g) static void usage(EpmdVars *g) { - fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-port No] [-daemon]\n"); - fprintf(stderr, " [-relaxed_command_check]\n"); + fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-address List]\n"); + fprintf(stderr, " [-port No] [-daemon] [-relaxed_command_check]\n"); fprintf(stderr, " epmd [-d|-debug] [-port No] [-names|-kill|-stop name]\n\n"); fprintf(stderr, "See the Erlang epmd manual page for info about the usage.\n\n"); fprintf(stderr, "Regular options\n"); + fprintf(stderr, " -address List\n"); + fprintf(stderr, " Let epmd listen only on the comma-separated list of IP\n"); + fprintf(stderr, " addresses (and on the loopback interface).\n"); fprintf(stderr, " -port No\n"); fprintf(stderr, " Let epmd listen to another port than default %d\n", EPMD_PORT_NO); @@ -487,8 +497,8 @@ static void dbg_gen_printf(int onsyslog,int perr,int from_level, (int) strlen(timestr)-1, timestr); len = strlen(buf); erts_vsnprintf(buf + len, DEBUG_BUFFER_SIZE - len, format, args); - if (perr == 1) - perror(buf); + if (perr != 0) + fprintf(stderr,"%s: %s\r\n",buf,strerror(perr)); else fprintf(stderr,"%s\r\n",buf); } @@ -499,7 +509,7 @@ void dbg_perror(EpmdVars *g,const char *format,...) { va_list args; va_start(args, format); - dbg_gen_printf(1,1,0,g,format,args); + dbg_gen_printf(1,errno,0,g,format,args); va_end(args); } @@ -555,8 +565,9 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval) epmd_conn_close(g,&g->conn[i]); free(g->conn); } - if(g->listenfd >= 0) - close(g->listenfd); + for(i=0; i < MAX_LISTEN_SOCKETS; i++) + if(g->listenfd[i] >= 0) + close(g->listenfd[i]); free_all_nodes(g); if(g->argv){ for(i=0; g->argv[i] != NULL; ++i) @@ -568,6 +579,10 @@ void epmd_cleanup_exit(EpmdVars *g, int exitval) exit(exitval); } +static char* get_addresses(void) +{ + return getenv("ERL_EPMD_ADDRESS"); +} static int get_port_no(void) { char* port_str = getenv("ERL_EPMD_PORT"); diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c index 7c60ba0420..ac55ba6bb6 100644 --- a/erts/epmd/src/epmd_cli.c +++ b/erts/epmd/src/epmd_cli.c @@ -137,7 +137,7 @@ static int conn_to_epmd(EpmdVars *g) { /* store port number in unsigned short */ unsigned short sport = g->port; - SET_ADDR_LOOPBACK(address, FAMILY, sport); + SET_ADDR(address, EPMD_ADDR_LOOPBACK, sport); } if (connect(connect_sock, (struct sockaddr*)&address, sizeof address) < 0) diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h index c2558d52a1..2a0de4df9c 100644 --- a/erts/epmd/src/epmd_int.h +++ b/erts/epmd/src/epmd_int.h @@ -168,42 +168,40 @@ #if defined(HAVE_IN6) && defined(AF_INET6) && defined(EPMD6) #define EPMD_SOCKADDR_IN sockaddr_in6 -#define FAMILY AF_INET6 - -#define SET_ADDR_LOOPBACK(addr, af, port) do { \ - memset((char*)&(addr), 0, sizeof(addr)); \ - (addr).sin6_family = (af); \ - (addr).sin6_flowinfo = 0; \ - (addr).sin6_addr = in6addr_loopback; \ - (addr).sin6_port = htons(port); \ +#define EPMD_IN_ADDR in6_addr +#define EPMD_S_ADDR s6_addr +#define EPMD_ADDR_LOOPBACK in6addr_loopback.s6_addr +#define EPMD_ADDR_ANY in6addr_any.s6_addr +#define FAMILY AF_INET6 + +#define SET_ADDR(dst, addr, port) do { \ + memset((char*)&(dst), 0, sizeof(dst)); \ + memcpy((char*)&(dst).sin6_addr.s6_addr, (char*)&(addr), 16); \ + (dst).sin6_family = AF_INET6; \ + (dst).sin6_flowinfo = 0; \ + (dst).sin6_port = htons(port); \ } while(0) -#define SET_ADDR_ANY(addr, af, port) do { \ - memset((char*)&(addr), 0, sizeof(addr)); \ - (addr).sin6_family = (af); \ - (addr).sin6_flowinfo = 0; \ - (addr).sin6_addr = in6addr_any; \ - (addr).sin6_port = htons(port); \ - } while(0) +#define IS_ADDR_LOOPBACK(addr) \ + (memcmp((addr).s6_addr, in6addr_loopback.s6_addr, 16) == 0) #else /* Not IP v6 */ #define EPMD_SOCKADDR_IN sockaddr_in -#define FAMILY AF_INET - -#define SET_ADDR_LOOPBACK(addr, af, port) do { \ - memset((char*)&(addr), 0, sizeof(addr)); \ - (addr).sin_family = (af); \ - (addr).sin_addr.s_addr = htonl(INADDR_LOOPBACK); \ - (addr).sin_port = htons(port); \ +#define EPMD_IN_ADDR in_addr +#define EPMD_S_ADDR s_addr +#define EPMD_ADDR_LOOPBACK htonl(INADDR_LOOPBACK) +#define EPMD_ADDR_ANY htonl(INADDR_ANY) +#define FAMILY AF_INET + +#define SET_ADDR(dst, addr, port) do { \ + memset((char*)&(dst), 0, sizeof(dst)); \ + (dst).sin_family = AF_INET; \ + (dst).sin_addr.s_addr = (addr); \ + (dst).sin_port = htons(port); \ } while(0) -#define SET_ADDR_ANY(addr, af, port) do { \ - memset((char*)&(addr), 0, sizeof(addr)); \ - (addr).sin_family = (af); \ - (addr).sin_addr.s_addr = htonl(INADDR_ANY); \ - (addr).sin_port = htons(port); \ - } while(0) +#define IS_ADDR_LOOPBACK(addr) ((addr).s_addr == htonl(INADDR_LOOPBACK)) #endif /* Not IP v6 */ @@ -231,6 +229,8 @@ /* Maximum length of a node name == atom name */ #define MAXSYMLEN 255 +#define MAX_LISTEN_SOCKETS 16 + #define INBUF_SIZE 1024 #define OUTBUF_SIZE 1024 @@ -299,7 +299,8 @@ typedef struct { Connection *conn; Nodes nodes; fd_set orig_read_mask; - int listenfd; + int listenfd[MAX_LISTEN_SOCKETS]; + char *addresses; char **argv; } EpmdVars; diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c index 3499ab2934..4d9b454f97 100644 --- a/erts/epmd/src/epmd_srv.c +++ b/erts/epmd/src/epmd_srv.c @@ -24,6 +24,10 @@ #include "epmd.h" /* Renamed from 'epmd_r4.h' */ #include "epmd_int.h" +#ifndef INADDR_NONE +# define INADDR_NONE 0xffffffff +#endif + /* * * This server is a local name server for Erlang nodes. Erlang nodes can @@ -79,91 +83,157 @@ static void print_names(EpmdVars*); void run(EpmdVars *g) { - int listensock; + struct EPMD_SOCKADDR_IN iserv_addr[MAX_LISTEN_SOCKETS]; + int listensock[MAX_LISTEN_SOCKETS]; + int num_sockets; int i; int opt; - struct EPMD_SOCKADDR_IN iserv_addr; + unsigned short sport = g->port; node_init(g); g->conn = conn_init(g); dbg_printf(g,2,"try to initiate listening port %d", g->port); - - if ((listensock = socket(FAMILY,SOCK_STREAM,0)) < 0) { - dbg_perror(g,"error opening stream socket"); - epmd_cleanup_exit(g,1); - } - g->listenfd = listensock; + + if (g->addresses != NULL) + { + char *tmp; + char *token; + int loopback_ok = 0; + + if ((tmp = (char *)malloc(strlen(g->addresses) + 1)) == NULL) + { + dbg_perror(g,"cannot allocate memory"); + epmd_cleanup_exit(g,1); + } + strcpy(tmp,g->addresses); + + for(token = strtok(tmp,", "), num_sockets = 0; + token != NULL; + token = strtok(NULL,", "), num_sockets++) + { + struct EPMD_IN_ADDR addr; +#ifdef HAVE_INET_PTON + int ret; + + if ((ret = inet_pton(FAMILY,token,&addr)) == -1) + { + dbg_perror(g,"cannot convert IP address to network format"); + epmd_cleanup_exit(g,1); + } + else if (ret == 0) +#elif !defined(EPMD6) + if ((addr.EPMD_S_ADDR = inet_addr(token)) == INADDR_NONE) +#endif + { + dbg_tty_printf(g,0,"cannot parse IP address \"%s\"",token); + epmd_cleanup_exit(g,1); + } + + if (IS_ADDR_LOOPBACK(addr)) + loopback_ok = 1; + + if (num_sockets - loopback_ok == MAX_LISTEN_SOCKETS - 1) + { + dbg_tty_printf(g,0,"cannot listen on more than %d IP addresses", + MAX_LISTEN_SOCKETS); + epmd_cleanup_exit(g,1); + } + + SET_ADDR(iserv_addr[num_sockets],addr.EPMD_S_ADDR,sport); + } + + free(tmp); + + if (!loopback_ok) + { + SET_ADDR(iserv_addr[num_sockets],EPMD_ADDR_LOOPBACK,sport); + num_sockets++; + } + } + else + { + SET_ADDR(iserv_addr[0],EPMD_ADDR_ANY,sport); + num_sockets = 1; + } + +#if !defined(__WIN32__) + /* We ignore the SIGPIPE signal that is raised when we call write + twice on a socket closed by the other end. */ + signal(SIGPIPE, SIG_IGN); +#endif /* * Initialize number of active file descriptors. * Stdin, stdout, and stderr are still open. - * One for the listen socket. */ - g->active_conn = 3+1; + g->active_conn = 3 + num_sockets; + g->max_conn -= num_sockets; + + FD_ZERO(&g->orig_read_mask); + + for (i = 0; i < num_sockets; i++) + { + if ((listensock[i] = socket(FAMILY,SOCK_STREAM,0)) < 0) + { + dbg_perror(g,"error opening stream socket"); + epmd_cleanup_exit(g,1); + } + g->listenfd[i] = listensock[i]; - /* - * Note that we must not enable the SO_REUSEADDR on Windows, - * because addresses will be reused even if they are still in use. - */ + /* + * Note that we must not enable the SO_REUSEADDR on Windows, + * because addresses will be reused even if they are still in use. + */ #if !defined(__WIN32__) - /* We ignore the SIGPIPE signal that is raised when we call write - twice on a socket closed by the other end. */ - signal(SIGPIPE, SIG_IGN); - - opt = 1; /* Set this option */ - if (setsockopt(listensock,SOL_SOCKET,SO_REUSEADDR,(char* ) &opt, - sizeof(opt)) <0) { - dbg_perror(g,"can't set sockopt"); - epmd_cleanup_exit(g,1); - } + opt = 1; + if (setsockopt(listensock[i],SOL_SOCKET,SO_REUSEADDR,(char* ) &opt, + sizeof(opt)) <0) + { + dbg_perror(g,"can't set sockopt"); + epmd_cleanup_exit(g,1); + } #endif - /* In rare cases select returns because there is someone - to accept but the request is withdrawn before the - accept function is called. We set the listen socket - to be non blocking to prevent us from being hanging - in accept() waiting for the next request. */ + /* In rare cases select returns because there is someone + to accept but the request is withdrawn before the + accept function is called. We set the listen socket + to be non blocking to prevent us from being hanging + in accept() waiting for the next request. */ #if (defined(__WIN32__) || defined(NO_FCNTL)) - opt = 1; - if (ioctl(listensock, FIONBIO, &opt) != 0) /* Gives warning in VxWorks */ + opt = 1; + /* Gives warning in VxWorks */ + if (ioctl(listensock[i], FIONBIO, &opt) != 0) #else - opt = fcntl(listensock, F_GETFL, 0); - if (fcntl(listensock, F_SETFL, opt | O_NONBLOCK) == -1) + opt = fcntl(listensock[i], F_GETFL, 0); + if (fcntl(listensock[i], F_SETFL, opt | O_NONBLOCK) == -1) #endif /* __WIN32__ || VXWORKS */ - dbg_perror(g,"failed to set non-blocking mode of listening socket %d", - listensock); + dbg_perror(g,"failed to set non-blocking mode of listening socket %d", + listensock[i]); - { /* store port number in unsigned short */ - unsigned short sport = g->port; - SET_ADDR_ANY(iserv_addr, FAMILY, sport); - } - - if(bind(listensock,(struct sockaddr*) &iserv_addr, sizeof(iserv_addr)) < 0 ) - { - if (errno == EADDRINUSE) + if (bind(listensock[i], (struct sockaddr*) &iserv_addr[i], + sizeof(iserv_addr[i])) < 0) { - dbg_tty_printf(g,1,"there is already a epmd running at port %d", - g->port); - epmd_cleanup_exit(g,0); - } - else - { - dbg_perror(g,"failed to bind socket"); - epmd_cleanup_exit(g,1); + if (errno == EADDRINUSE) + { + dbg_tty_printf(g,1,"there is already a epmd running at port %d", + g->port); + epmd_cleanup_exit(g,0); + } + else + { + dbg_perror(g,"failed to bind socket"); + epmd_cleanup_exit(g,1); + } } - } - - dbg_printf(g,2,"starting"); - if(listen(listensock, SOMAXCONN) < 0) { - dbg_perror(g,"failed to listen on socket"); - epmd_cleanup_exit(g,1); - } - - FD_ZERO(&g->orig_read_mask); - FD_SET(listensock,&g->orig_read_mask); + if(listen(listensock[i], SOMAXCONN) < 0) { + dbg_perror(g,"failed to listen on socket"); + epmd_cleanup_exit(g,1); + } + FD_SET(listensock[i],&g->orig_read_mask); + } dbg_tty_printf(g,2,"entering the main select() loop"); @@ -200,17 +270,18 @@ void run(EpmdVars *g) sleep(g->delay_accept); } - if (FD_ISSET(listensock,&read_mask)) { - if (do_accept(g, listensock) && g->active_conn < g->max_conn) { - /* - * The accept() succeeded, and we have at least one file - * descriptor still free, which means that another accept() - * could succeed. Go do do another select(), in case there - * are more incoming connections waiting to be accepted. - */ - goto select_again; + for (i = 0; i < num_sockets; i++) + if (FD_ISSET(listensock[i],&read_mask)) { + if (do_accept(g, listensock[i]) && g->active_conn < g->max_conn) { + /* + * The accept() succeeded, and we have at least one file + * descriptor still free, which means that another accept() + * could succeed. Go do do another select(), in case there + * are more incoming connections waiting to be accepted. + */ + goto select_again; + } } - } /* Check all open streams marked by select for data or a close. We also close all open sockets except ALIVE @@ -738,6 +809,7 @@ static int conn_open(EpmdVars *g,int fd) for (i = 0; i < g->max_conn; i++) { if (g->conn[i].open == EPMD_FALSE) { struct sockaddr_in si; + struct sockaddr_in di; #ifdef HAVE_SOCKLEN_T socklen_t st; #else @@ -758,12 +830,16 @@ static int conn_open(EpmdVars *g,int fd) /* Determine if connection is from localhost */ if (getpeername(s->fd,(struct sockaddr*) &si,&st) || st < sizeof(si)) { - /* Failure to get peername is regarder as non local host */ + /* Failure to get peername is regarded as non local host */ s->local_peer = EPMD_FALSE; } else { + /* Only 127.x.x.x and connections from the host's IP address + allowed, no false positives */ s->local_peer = - ((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) == - 0x7F000000U); /* Only 127.x.x.x allowed, no false positives */ + (((((unsigned) ntohl(si.sin_addr.s_addr)) & 0xFF000000U) == + 0x7F000000U) || + (getsockname(s->fd,(struct sockaddr*) &di,&st) ? + EPMD_FALSE : si.sin_addr.s_addr == di.sin_addr.s_addr)); } dbg_tty_printf(g,2,(s->local_peer) ? "Local peer connected" : "Non-local peer connected"); diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c index 778b3569c7..7a5746e630 100644 --- a/erts/etc/common/heart.c +++ b/erts/etc/common/heart.c @@ -727,16 +727,16 @@ static int heart_cmd_reply(int fd, char *s) { struct msg m; - int len = strlen(s) + 1; /* Include \0 */ + int len = strlen(s); /* if s >= MSG_BODY_SIZE, return a write * failure immediately. */ - if (len > sizeof(m.fill)) + if (len >= sizeof(m.fill)) return -1; m.op = HEART_CMD; - m.len = htons(len + 2); /* Include Op */ + m.len = htons(len + 1); /* Include Op */ strcpy((char*)m.fill, s); return write_message(fd, &m); diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c index 886b301997..b7c3c956c6 100644 --- a/erts/etc/unix/to_erl.c +++ b/erts/etc/unix/to_erl.c @@ -125,7 +125,7 @@ static void usage(char *pname) int main(int argc, char **argv) { char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; - int i, len, wfd, rfd, result = 0; + int i, len, wfd, rfd; fd_set readfds; char buf[BUFSIZ]; char pipename[FILENAME_MAX]; @@ -367,7 +367,6 @@ int main(int argc, char **argv) } else { fprintf(stderr, "Error in select.\n"); - result = -1; break; } } @@ -398,7 +397,6 @@ int main(int argc, char **argv) close(wfd); if (len < 0) { fprintf(stderr, "Error in reading from stdin.\n"); - result = -1; } else { fprintf(stderr, "[EOF]\n\r"); } @@ -420,7 +418,6 @@ int main(int argc, char **argv) fprintf(stderr, "Error in writing to FIFO.\n"); close(rfd); close(wfd); - result = -1; break; } STATUS("\" OK\r\n"); @@ -447,7 +444,6 @@ int main(int argc, char **argv) close(wfd); if (len < 0) { fprintf(stderr, "Error in reading from FIFO.\n"); - result = -1; } else fprintf(stderr, "[End]\n\r"); break; @@ -456,7 +452,6 @@ int main(int argc, char **argv) if ((len=version_handshake(buf,len,wfd)) < 0) { close(rfd); close(wfd); - result = -1; break; } if (protocol_ver >= 1) { @@ -475,7 +470,6 @@ int main(int argc, char **argv) fprintf(stderr, "Error in writing to terminal.\n"); close(rfd); close(wfd); - result = -1; break; } STATUS("\" OK\r\n"); diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index bd3d38e649..968d563325 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * Copyright Ericsson AB 2005-2011. All Rights Reserved. * * The contents of this file are subject to the Erlang Public License, * Version 1.1, (the "License"); you may not use this file except in @@ -27,7 +27,7 @@ * length: hh | h | l | ll | L | j | t | b<sz> * conversion: d,i | o,u,x,X | e,E | f,F | g,G | a,A | c | s | T | * p | n | % - * sz: 8 | 16 | 32 | 64 | p + * sz: 8 | 16 | 32 | 64 | p | e */ /* Without this, variable argument lists break on VxWorks */ @@ -76,6 +76,18 @@ #endif #endif +#ifndef ERTS_SIZEOF_ETERM +# ifdef HALFWORD_HEAP_EMULATOR +# if SIZEOF_VOID_P == 8 +# define ERTS_SIZEOF_ETERM 4 +# else +# error "HALFWORD_HEAP_EMULATOR only allowed on 64-bit architecture" +# endif +# else +# define ERTS_SIZEOF_ETERM SIZEOF_VOID_P +# endif +#endif + #if defined(__GNUC__) # undef inline # define inline __inline__ @@ -520,6 +532,17 @@ int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) #error No integer datatype with the same size as 'void *' found #endif } + else if (*ptr == 'e') { + ptr++; +#if SIZEOF_INT == ERTS_SIZEOF_ETERM +#elif SIZEOF_LONG == ERTS_SIZEOF_ETERM + fmt |= FMTL_l; +#elif SIZEOF_LONG_LONG == ERTS_SIZEOF_ETERM + fmt |= FMTL_ll; +#else +#error No integer datatype with the same size as Eterm found +#endif + } else { int bits = 0; while(isdigit((int) *ptr)) diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam Binary files differindex 4a75e43e73..c2ae01d0d5 100644 --- a/erts/preloaded/ebin/prim_file.beam +++ b/erts/preloaded/ebin/prim_file.beam diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl index 10be852e92..fb0aef8947 100644 --- a/erts/preloaded/src/prim_file.erl +++ b/erts/preloaded/src/prim_file.erl @@ -64,7 +64,7 @@ -include("file.hrl"). -define(DRV, efile). --define(FD_DRV, efile). +-define(FD_DRV, "efile"). -define(LARGEFILESIZE, (1 bsl 63)). @@ -506,7 +506,7 @@ read_file(_) -> %% Takes a Port opened with open/1. read_file(Port, File) when is_port(Port), - (is_list(File) orelse is_binary(File))-> + (is_list(File) orelse is_binary(File)) -> Cmd = [?FILE_READ_FILE | pathname(File)], case drv_command(Port, Cmd) of {error, enomem} -> @@ -832,7 +832,7 @@ drv_open(Driver, Portopts) -> {ok, Port} catch error:Reason -> - {error,Reason} + {error, Reason} end. @@ -1041,8 +1041,8 @@ translate_response(?FILE_RESP_NUMBER, List) -> {N, []} = get_uint64(List), {ok, N}; translate_response(?FILE_RESP_DATA, List) -> - {N, Data} = get_uint64(List), - {ok, {N, Data}}; + {_N, _Data} = ND = get_uint64(List), + {ok, ND}; translate_response(?FILE_RESP_INFO, List) when is_list(List) -> {ok, transform_info_ints(get_uint32s(List))}; translate_response(?FILE_RESP_NUMERR, L0) -> @@ -1087,10 +1087,8 @@ translate_response(?FILE_RESP_FNAME, Data) when is_binary(Data) -> {ok, prim_file:internal_native2name(Data)}; translate_response(?FILE_RESP_FNAME, Data) -> {ok, Data}; - translate_response(?FILE_RESP_ALL_DATA, Data) -> {ok, Data}; - translate_response(X, Data) -> {error, {bad_response_from_port, [X | Data]}}. @@ -1137,14 +1135,14 @@ date_to_bytes(undefined) -> date_to_bytes({{Y, Mon, D}, {H, Min, S}}) -> <<Y:32, Mon:32, D:32, H:32, Min:32, S:32>>. -% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) -> -% (uint32(Y1) bsl 32) bor uint32(Y2). +%% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) -> +%% (uint32(Y1) bsl 32) bor uint32(Y2). -% uint64(X1, X2, X3, X4, X5, X6, X7, X8) -> -% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8). +%% uint64(X1, X2, X3, X4, X5, X6, X7, X8) -> +%% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8). -% uint32([X1,X2,X3,X4]) -> -% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. +%% uint32([X1,X2,X3,X4]) -> +%% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. uint32(X1,X2,X3,X4) -> (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 1ee73b890b..c92566de37 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -296,7 +296,7 @@ </func> <func> - <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {skip,Reason}</name> + <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {fail,Reason} | {skip,Reason}</name> <fsummary>Test case initialization.</fsummary> <type> <v> TestCase = atom()</v> @@ -311,10 +311,12 @@ <p>This function is called before each test case. The <c>TestCase</c> argument is the name of the test case, and - <c>Config</c> is the configuration which can be modified - here. Whatever is returned from this function is given as - <c>Config</c> to the test case. If <c>{skip,Reason}</c> is returned, - the test case will be skipped and <c>Reason</c> printed + <c>Config</c> (list of key-value tuples) is the configuration + data that can be modified here. The <c>NewConfig</c> list returned + from this function is given as <c>Config</c> to the test case. + If <c>{fail,Reason}</c> is returned, the test case is + marked as failed without being executed. If <c>{skip,Reason}</c> is + returned, the test case will be skipped and <c>Reason</c> printed in the overview log for the suite.</p> </desc> </func> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 723492d8f3..3f9fdb7121 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -167,12 +167,16 @@ returning <c>{fail,Reason}</c>, nor will it be able to save data with <c>{save_config,Data}</c>.</p> - <p>If <c>init_per_testcase</c> crashes, the test case itself is skipped + <p>If <c>init_per_testcase</c> crashes, the test case itself gets skipped automatically (so called <em>auto skipped</em>). If <c>init_per_testcase</c> - returns a <c>skip</c> tuple, also then will the test case be skipped (so - called <em>user skipped</em>). In either event, the <c>end_per_testcase</c> is - never called. + returns a tuple <c>{skip,Reason}</c>, also then the test case gets skipped + (so called <em>user skipped</em>). It is also possible, by returning a tuple + <c>{fail,Reason}</c> from <c>init_per_testcase</c>, to mark the test case + as failed without actually executing it. </p> + <note><p>If <c>init_per_testcase</c> crashes, or returns <c>{skip,Reason}</c> + or <c>{fail,Reason}</c>, the <c>end_per_testcase</c> function is not called. + </p></note> <p>If it is determined during execution of <c>end_per_testcase</c> that the status of a successful test case should be changed to failed, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index dfec2b7a67..66da3ef742 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -861,6 +861,7 @@ remove_config(Callback, Config) -> %%% %%% @doc <p>Use this function to set a new timetrap for the running test case.</p> timetrap(Time) -> + test_server:timetrap_cancel(), test_server:timetrap(Time). %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 38a2aa53ac..c016b9c66b 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -24,7 +24,7 @@ -module(ct_framework). --export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). +-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). -export([error_notification/4]). -export([overview_html_header/1]). @@ -434,6 +434,9 @@ try_set_default(Name,Key,Info,Where) -> %%% %%% @doc Test server framework callback, called by the test_server %%% when a test case is finished. +end_tc(Mod, Fun, Args) -> + %% Have to keep end_tc/3 for backwards compatabilty issues + end_tc(Mod, Fun, Args, '$end_tc_dummy'). end_tc(?MODULE,error_in_suite,_, _) -> % bad start! ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> @@ -490,9 +493,9 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> case ct_hooks:end_tc( Mod, FuncSpec, Args, Result, Return) of '$ct_no_change' -> - {FinalResult = ok,Result}; - FinalResult -> - {FinalResult,FinalResult} + {ok,Result}; + FinalResult1 -> + {FinalResult1,FinalResult1} end, % send sync notification so that event handlers may print % in the log file before it gets closed @@ -734,7 +737,7 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> %% (and only) test case so we can report Error properly [{?MODULE,error_in_suite,[[Error]]}]; [] -> - {error,{invalid_group_spec,Name}}; + []; ConfTests -> case lists:member(skipped, Props) of true -> @@ -764,23 +767,7 @@ get_suite(Mod, Name) -> find_groups(Mod, Name, TCs, GroupDefs) -> Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false), - Trimmed = trim(Found), - %% I cannot find a reason to why this function is called, - %% It deletes any group which is referenced in any other - %% group. i.e. - %% groups() -> - %% [{test, [], [testcase1]}, - %% {testcases, [], [{group, test}]}]. - %% Would be changed to - %% groups() -> - %% [{testcases, [], [testcase1]}]. - %% instead of what I believe is correct: - %% groups() -> - %% [{test, [], [testcase1]}, - %% {testcases, [], [testcase1]}]. - %% Have to double check with peppe - delete_subs(Trimmed, Trimmed), - Trimmed. + trim(Found). find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) when is_atom(Name), is_list(Props), is_list(Tests) -> @@ -1170,12 +1157,14 @@ error_in_suite(Config) -> %% if the group config functions are missing in the suite, %% use these instead ct_init_per_group(GroupName, Config) -> - ct_logs:log("WARNING", "init_per_group/2 for ~w missing in suite, using default.", + ct_logs:log("WARNING", "init_per_group/2 for ~w missing " + "in suite, using default.", [GroupName]), Config. ct_end_per_group(GroupName, _) -> - ct_logs:log("WARNING", "end_per_group/2 for ~w missing in suite, using default.", + ct_logs:log("WARNING", "end_per_group/2 for ~w missing " + "in suite, using default.", [GroupName]), ok. @@ -1184,6 +1173,13 @@ ct_end_per_group(GroupName, _) -> %%% @spec report(What,Data) -> ok report(What,Data) -> case What of + loginfo -> + %% logfiles and direcories have been created for a test and the + %% top level test index page needs to be refreshed + TestName = filename:basename(proplists:get_value(topdir, Data), ".logs"), + RunDir = proplists:get_value(rundir, Data), + ct_logs:make_all_suites_index({TestName,RunDir}), + ok; tests_start -> case ct_util:get_testdata(cover) of undefined -> diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index f8ace73cbf..ba4adb8683 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -97,11 +97,11 @@ logdir_node_prefix() -> logdir_prefix()++"."++atom_to_list(node()). %%%----------------------------------------------------------------- -%%% @spec close(How) -> ok +%%% @spec close(Info) -> ok %%% %%% @doc Create index pages with test results and close the CT Log %%% (tool-internal use only). -close(How) -> +close(Info) -> make_last_run_index(), ct_event:notify(#event{name=stop_logging,node=node(),data=[]}), @@ -118,7 +118,7 @@ close(How) -> ok end, - if How == clean -> + if Info == clean -> case cleanup() of ok -> ok; @@ -427,8 +427,8 @@ logger(Parent,Mode) -> file:make_dir(Dir), ct_event:notify(#event{name=start_logging,node=node(), data=?abs(Dir)}), - make_all_suites_index(start), make_all_runs_index(start), + make_all_suites_index(start), case Mode of interactive -> interactive_link(); _ -> ok @@ -796,24 +796,29 @@ make_one_index_entry(SuiteName, LogDir, Label, All, Missing) -> {Succ,Fail,UserSkip,AutoSkip} -> NotBuilt = not_built(SuiteName, LogDir, All, Missing), NewResult = make_one_index_entry1(SuiteName, LogDir, Label, Succ, Fail, - UserSkip, AutoSkip, NotBuilt, All), + UserSkip, AutoSkip, NotBuilt, All, + normal), {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt}; error -> error end. make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip, - NotBuilt, All) -> + NotBuilt, All, Mode) -> LogFile = filename:join(Link, ?suitelog_name ++ ".html"), - CrashDumpName = SuiteName ++ "_erl_crash.dump", - CrashDumpLink = - case filelib:is_file(CrashDumpName) of - true -> - [" <A HREF=\"", CrashDumpName, - "\">(CrashDump)</A>"]; - false -> - "" - end, + CrashDumpLink = case Mode of + cached -> + ""; + normal -> + CrashDumpName = SuiteName ++ "_erl_crash.dump", + case filelib:is_file(CrashDumpName) of + true -> + [" <A HREF=\"", CrashDumpName, + "\">(CrashDump)</A>"]; + false -> + "" + end + end, {Lbl,Timestamp,Node,AllInfo} = case All of {true,OldRuns} -> @@ -975,9 +980,13 @@ index_header(Label, StartTime) -> "<th>Missing<br>Suites</th>\n" "\n"]]. + all_suites_index_header() -> {ok,Cwd} = file:get_cwd(), - LogDir = filename:basename(Cwd), + all_suites_index_header(Cwd). + +all_suites_index_header(IndexDir) -> + LogDir = filename:basename(IndexDir), AllRuns = "All test runs in \"" ++ LogDir ++ "\"", [header("Test Results") | ["<CENTER>\n", @@ -1414,15 +1423,72 @@ timestamp(Dir) -> [S,Min,H,D,M,Y] = [list_to_integer(N) || N <- lists:sublist(TsR,6)], format_time({{Y,M,D},{H,Min,S}}). -make_all_suites_index(When) -> +%% ----------------------------- NOTE -------------------------------------- +%% The top level index file is generated based on the file contents under +%% logdir. This takes place initially when the test run starts (When = start) +%% and an update takes place at the end of the test run, or when the user +%% requests an explicit refresh (When = refresh). +%% The index file needs to be updated also at the start of each individual +%% test (in order for the user to be able to track test progress by refreshing +%% the browser). Since it would be too expensive to generate a new file from +%% scratch every time (by reading the data from disk), a copy of the dir tree +%% is cached as a result of the first index file creation. This copy is then +%% used for all top level index page updates that occur during the test run. +%% This means that any changes to the dir tree under logdir during the test +%% run will not show until after the final refresh. +%% ------------------------------------------------------------------------- + +%% Creates the top level index file. When == start | refresh. +%% A copy of the dir tree under logdir is cached as a result. +make_all_suites_index(When) when is_atom(When) -> AbsIndexName = ?abs(?index_name), notify_and_lock_file(AbsIndexName), LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext), - Sorted = sort_logdirs(LogDirs,[]), - Result = make_all_suites_index1(When,Sorted), + Sorted = sort_logdirs(LogDirs, []), + Result = make_all_suites_index1(When, AbsIndexName, Sorted), notify_and_unlock_file(AbsIndexName), - Result. - + Result; + +%% This updates the top level index file using cached data from +%% the initial index file creation. +make_all_suites_index(NewTestData = {_TestName,DirName}) -> + %% AllLogDirs = [{TestName,Label,Missing,{LastLogDir,Summary},OldDirs}|...] + {AbsIndexName,LogDirData} = ct_util:get_testdata(test_index), + + CtRunDirPos = length(filename:split(AbsIndexName)), + CtRunDir = filename:join(lists:sublist(filename:split(DirName), + CtRunDirPos)), + + Label = case read_totals_file(filename:join(CtRunDir, ?totals_name)) of + {_,"-",_,_} -> "..."; + {_,Lbl,_,_} -> Lbl; + _ -> "..." + end, + notify_and_lock_file(AbsIndexName), + Result = + case catch make_all_suites_ix_cached(AbsIndexName, + NewTestData, + Label, + LogDirData) of + {'EXIT',Reason} -> + io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), + io:format("~p~n", [Reason]), + {error,Reason}; + {error,Reason} -> + io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"), + io:format("~p~n", [Reason]), + {error,Reason}; + ok -> + ok; + Err -> + io:format("Unknown internal error while updating ~s. " + "Please report.\n(Err: ~p, ID: 1)", + [AbsIndexName,Err]), + {error, Err} + end, + notify_and_unlock_file(AbsIndexName), + Result. + sort_logdirs([Dir|Dirs],Groups) -> TestName = filename:rootname(filename:basename(Dir)), case filelib:wildcard(filename:join(Dir,"run.*")) of @@ -1448,13 +1514,12 @@ sort_each_group([{Test,IxDirs}|Groups]) -> sort_each_group([]) -> []. -make_all_suites_index1(When,AllSuitesLogDirs) -> +make_all_suites_index1(When, AbsIndexName, AllLogDirs) -> IndexName = ?index_name, - AbsIndexName = ?abs(IndexName), if When == start -> ok; true -> io:put_chars("Updating " ++ AbsIndexName ++ "... ") end, - case catch make_all_suites_index2(IndexName,AllSuitesLogDirs) of + case catch make_all_suites_index2(IndexName, AllLogDirs) of {'EXIT', Reason} -> io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), io:format("~p~n", [Reason]), @@ -1463,11 +1528,16 @@ make_all_suites_index1(When,AllSuitesLogDirs) -> io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"), io:format("~p~n", [Reason]), {error, Reason}; - ok -> - if When == start -> ok; - true -> io:put_chars("done\n") - end, - ok; + {ok,CacheData} -> + case When of + start -> + ct_util:set_testdata_async({test_index,{AbsIndexName, + CacheData}}), + ok; + _ -> + io:put_chars("done\n"), + ok + end; Err -> io:format("Unknown internal error while updating ~s. " "Please report.\n(Err: ~p, ID: 1)", @@ -1475,56 +1545,124 @@ make_all_suites_index1(When,AllSuitesLogDirs) -> {error, Err} end. -make_all_suites_index2(IndexName,AllSuitesLogDirs) -> - {ok,Index0,_Totals} = make_all_suites_index3(AllSuitesLogDirs, - all_suites_index_header(), - 0, 0, 0, 0, 0, []), +make_all_suites_index2(IndexName, AllTestLogDirs) -> + {ok,Index0,_Totals,CacheData} = + make_all_suites_index3(AllTestLogDirs, + all_suites_index_header(), + 0, 0, 0, 0, 0, [], []), Index = [Index0|index_footer()], case force_write_file(IndexName, Index) of ok -> - ok; + {ok,CacheData}; {error, Reason} -> {error,{index_write_error, Reason}} end. -make_all_suites_index3([{SuiteName,[LastLogDir|OldDirs]}|Rest], +make_all_suites_index3([{TestName,[LastLogDir|OldDirs]}|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, - Labels) -> + Labels, CacheData) -> [EntryDir|_] = filename:split(LastLogDir), Missing = - case file:read_file(filename:join(EntryDir,?missing_suites_info)) of + case file:read_file(filename:join(EntryDir, ?missing_suites_info)) of {ok,Bin} -> binary_to_term(Bin); _ -> [] end, {Label,Labels1} = case proplists:get_value(EntryDir, Labels) of undefined -> - case read_totals_file(filename:join(EntryDir,?totals_name)) of + case read_totals_file(filename:join(EntryDir, ?totals_name)) of {_,Lbl,_,_} -> {Lbl,[{EntryDir,Lbl}|Labels]}; _ -> {"-",[{EntryDir,"-"}|Labels]} end; Lbl -> {Lbl,Labels} end, - case make_one_index_entry(SuiteName, LastLogDir, Label, {true,OldDirs}, Missing) of + case make_one_index_entry(TestName, LastLogDir, Label, {true,OldDirs}, Missing) of {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> %% for backwards compatibility AutoSkip1 = case catch AutoSkip+ASkip of {'EXIT',_} -> undefined; Res -> Res end, + IxEntry = {TestName,Label,Missing, + {LastLogDir,{Succ,Fail,USkip,ASkip}},OldDirs}, make_all_suites_index3(Rest, [Result|Result1], TotSucc+Succ, TotFail+Fail, UserSkip+USkip, AutoSkip1, - TotNotBuilt+NotBuilt,Labels1); + TotNotBuilt+NotBuilt, Labels1, + [IxEntry|CacheData]); error -> + IxEntry = {TestName,Label,Missing,{LastLogDir,error},OldDirs}, make_all_suites_index3(Rest, Result, TotSucc, TotFail, - UserSkip, AutoSkip, TotNotBuilt,Labels1) + UserSkip, AutoSkip, TotNotBuilt, Labels1, + [IxEntry|CacheData]) end; make_all_suites_index3([], Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt,_) -> + TotNotBuilt, _, CacheData) -> {ok, [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt,true)], - {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}}. + {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}, lists:reverse(CacheData)}. + + +make_all_suites_ix_cached(AbsIndexName, NewTestData, Label, AllTestLogDirs) -> + AllTestLogDirs1 = insert_new_test_data(NewTestData, Label, AllTestLogDirs), + IndexDir = filename:dirname(AbsIndexName), + Index0 = make_all_suites_ix_cached1(AllTestLogDirs1, + all_suites_index_header(IndexDir), + 0, 0, 0, 0, 0), + Index = [Index0|index_footer()], + case force_write_file(AbsIndexName, Index) of + ok -> + ok; + {error, Reason} -> + {error,{index_write_error, Reason}} + end. + +insert_new_test_data({NewTestName,NewTestDir}, NewLabel, AllTestLogDirs) -> + AllTestLogDirs1 = + case lists:keysearch(NewTestName, 1, AllTestLogDirs) of + {value,{_,_,_,{LastLogDir,_},OldDirs}} -> + [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}}, + [LastLogDir|OldDirs]} | + lists:keydelete(NewTestName, 1, AllTestLogDirs)]; + false -> + [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}},[]} | + AllTestLogDirs] + end, + lists:keysort(1, AllTestLogDirs1). + +make_all_suites_ix_cached1([{TestName,Label,Missing,LastLogDirData,OldDirs}|Rest], + Result, TotSucc, TotFail, UserSkip, AutoSkip, + TotNotBuilt) -> + case make_one_ix_entry_cached(TestName, LastLogDirData, + Label, {true,OldDirs}, Missing) of + {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> + %% for backwards compatibility + AutoSkip1 = case catch AutoSkip+ASkip of + {'EXIT',_} -> undefined; + Res -> Res + end, + make_all_suites_ix_cached1(Rest, [Result|Result1], TotSucc+Succ, + TotFail+Fail, UserSkip+USkip, AutoSkip1, + TotNotBuilt+NotBuilt); + error -> + make_all_suites_ix_cached1(Rest, Result, TotSucc, TotFail, + UserSkip, AutoSkip, TotNotBuilt) + end; +make_all_suites_ix_cached1([], Result, TotSucc, TotFail, UserSkip, AutoSkip, + TotNotBuilt) -> + [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, true)]. + +make_one_ix_entry_cached(TestName, {LogDir,Summary}, Label, All, Missing) -> + case Summary of + {Succ,Fail,UserSkip,AutoSkip} -> + NotBuilt = not_built(TestName, LogDir, All, Missing), + NewResult = make_one_index_entry1(TestName, LogDir, Label, + Succ, Fail, UserSkip, AutoSkip, + NotBuilt, All, cached), + {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt}; + error -> + error + end. %%----------------------------------------------------------------- %% Remove log files. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 7bd7dc7d66..c01e97b358 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -262,15 +262,15 @@ run_or_refresh(StartOpts = #opts{logdir = LogDir}, Args) -> %% give the shell time to print version etc timer:sleep(500), io:nl(), - case catch ct_logs:make_all_suites_index(refresh) of - {'EXIT',ASReason} -> + case catch ct_logs:make_all_runs_index(refresh) of + {'EXIT',ARReason} -> file:set_cwd(Cwd), - {error,{all_suites_index,ASReason}}; + {error,{all_runs_index,ARReason}}; _ -> - case catch ct_logs:make_all_runs_index(refresh) of - {'EXIT',ARReason} -> + case catch ct_logs:make_all_suites_index(refresh) of + {'EXIT',ASReason} -> file:set_cwd(Cwd), - {error,{all_runs_index,ARReason}}; + {error,{all_suites_index,ASReason}}; _ -> file:set_cwd(Cwd), io:format("Logs in ~s refreshed!~n~n", [LogDir1]), @@ -1111,6 +1111,8 @@ run(TestDirs) -> install([]), reformat_result(catch do_run(tests(TestDirs), [])). +reformat_result({'EXIT',{user_error,Reason}}) -> + {error,Reason}; reformat_result({user_error,Reason}) -> {error,Reason}; reformat_result(Result) -> diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 115207beed..b3e345b4e5 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -37,7 +37,7 @@ read_suite_data/1, delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, - update_testdata/2]). + set_testdata_async/1, update_testdata/2]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, @@ -96,7 +96,8 @@ start(Mode,LogDir) -> Pid = spawn_link(fun() -> do_start(S,Mode,LogDir) end), receive {Pid,started} -> Pid; - {Pid,Error} -> exit(Error) + {Pid,Error} -> exit(Error); + {_Ref,{Pid,Error}} -> exit(Error) end; Pid -> case get_mode() of @@ -162,21 +163,19 @@ do_start(Parent,Mode,LogDir) -> end, {StartTime,TestLogDir} = ct_logs:init(Mode), - %% Initiate ct_hooks + ct_event:notify(#event{name=test_start, + node=node(), + data={StartTime, + lists:flatten(TestLogDir)}}), + %% Initialize ct_hooks case catch ct_hooks:init(Opts) of ok -> - ok; + Parent ! {self(),started}; {_,CTHReason} -> ct_logs:tc_print('Suite Callback',CTHReason,[]), - Parent ! {self(), CTHReason}, - self() ! {{stop,normal},{self(),make_ref()}} + self() ! {{stop,{self(),{user_error,CTHReason}}}, + {Parent,make_ref()}} end, - - ct_event:notify(#event{name=test_start, - node=node(), - data={StartTime, - lists:flatten(TestLogDir)}}), - Parent ! {self(),started}, loop(Mode,[],StartDir). create_table(TableName,KeyPos) -> @@ -232,6 +231,9 @@ update_testdata(Key, Fun) -> set_testdata(TestData) -> call({set_testdata, TestData}). +set_testdata_async(TestData) -> + cast({set_testdata, TestData}). + get_testdata(Key) -> call({get_testdata, Key}). @@ -317,7 +319,7 @@ loop(Mode,TestData,StartDir) -> {reset_cwd,From} -> return(From,file:set_cwd(StartDir)), loop(From,TestData,StartDir); - {{stop,How},From} -> + {{stop,Info},From} -> Time = calendar:local_time(), ct_event:sync_notify(#event{name=test_done, node=node(), @@ -330,11 +332,11 @@ loop(Mode,TestData,StartDir) -> ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), - ct_logs:close(How), + ct_logs:close(Info), ct_event:stop(), ct_config:stop(), file:set_cwd(StartDir), - return(From,ok); + return(From, Info); {Ref, _Msg} when is_reference(Ref) -> %% This clause is used when doing cast operations. loop(Mode,TestData,StartDir); @@ -537,16 +539,16 @@ reset_silent_connections() -> %%%----------------------------------------------------------------- -%%% @spec stop(How) -> ok +%%% @spec stop(Info) -> ok %%% %%% @doc Stop the ct_util_server and close all existing connections %%% (tool-internal use only). %%% %%% @see ct -stop(How) -> +stop(Info) -> case whereis(ct_util_server) of undefined -> ok; - _ -> call({stop,How}) + _ -> call({stop,Info}) end. %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index 2ee982d726..081f98e889 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -281,9 +281,7 @@ run_test1(State=#state{tests=Tests,current_log_dir=LogDir}) -> end, unlink(Self) end, - Pid = spawn_link(RunTest), - Total = receive {{test_info,start_info,{_,_,Cases}},From} -> @@ -480,7 +478,7 @@ create_testdir_entries([],_N) -> []. testdir_entry(Dir,Suite,Case,N) -> - NStr = integer_to_list(N), + NStr = vts_integer_to_list(N), tr([td(delete_button(NStr)), td(Dir), td(suite_select(Dir,Suite,NStr)), @@ -691,11 +689,11 @@ result_summary_frame1(State) -> result_summary_body(State) -> N = State#state.ok + State#state.fail + State#state.skip, [h2("Result Summary"), - p([b(integer_to_list(N))," cases executed (of ", - b(integer_to_list(State#state.total)),")"]), - p([green([b(integer_to_list(State#state.ok))," successful"]),br(), - red([b(integer_to_list(State#state.fail))," failed"]),br(), - orange([b(integer_to_list(State#state.skip))," skipped"])]), + p([b(vts_integer_to_list(N))," cases executed (of ", + b(vts_integer_to_list(State#state.total)),")"]), + p([green([b(vts_integer_to_list(State#state.ok))," successful"]),br(), + red([b(vts_integer_to_list(State#state.fail))," failed"]),br(), + orange([b(vts_integer_to_list(State#state.skip))," skipped"])]), executed_test_list(State)]. executed_test_list(#state{testruns=[]}) -> @@ -735,6 +733,14 @@ report1(tc_done,{_Suite,init_per_suite,_},State) -> State; report1(tc_done,{_Suite,end_per_suite,_},State) -> State; +report1(tc_done,{_Suite,init_per_group,_},State) -> + State; +report1(tc_done,{_Suite,end_per_group,_},State) -> + State; +report1(tc_done,{_Suite,ct_init_per_group,_},State) -> + State; +report1(tc_done,{_Suite,ct_end_per_group,_},State) -> + State; report1(tc_done,{_Suite,_Case,ok},State) -> State#state{ok=State#state.ok+1}; report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> @@ -742,7 +748,9 @@ report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> report1(tc_done,{_Suite,_Case,{skipped,_Reason}},State) -> State#state{skip=State#state.skip+1}; report1(tc_user_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}. + State#state{skip=State#state.skip+1}; +report1(loginfo,_,State) -> + State. get_test_log(TestName,LogDir) -> [Log] = @@ -882,3 +890,7 @@ get_input_data(Input,Key)-> parse(Input) -> httpd:parse_query(Input). +vts_integer_to_list(X) when is_atom(X) -> + atom_to_list(X); +vts_integer_to_list(X) when is_integer(X) -> + integer_to_list(X). diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl index b6b50f33e0..8ce75f582a 100644 --- a/lib/common_test/test/ct_config_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE.erl @@ -174,7 +174,8 @@ run_test(Name, Config, CTConfig, SuiteNames)-> TestEvents = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(Name, reformat_events(TestEvents, ?eh), - ?config(config_dir, Config)), + ?config(config_dir, Config), + Opts), ExpEvents = events_to_check(Name), ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config). diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index ad6cf1ba8f..6867e59b60 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -102,8 +102,9 @@ cfg_error(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(cfg_error, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(cfg_error), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -120,8 +121,9 @@ lib_error(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(lib_error, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(lib_error), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -138,8 +140,9 @@ no_compile(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(no_compile, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(no_compile), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -156,7 +159,8 @@ timetrap_end_conf(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_end_conf, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_end_conf), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -176,7 +180,8 @@ timetrap_normal(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_normal, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_normal), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -198,12 +203,31 @@ timetrap_extended(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_extended, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_extended), ok = ct_test_support:verify_events(TestEvents, Events, Config). %%%----------------------------------------------------------------- +%%% +timetrap_parallel(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Join = fun(D, S) -> filename:join(D, "error/test/"++S) end, + Suite = Join(DataDir, "timetrap_3_SUITE"), + {Opts,ERPid} = setup([{suite,Suite}], Config), + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(timetrap_parallel, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(timetrap_parallel), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -236,7 +260,7 @@ test_events(cfg_error) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{14,14,42}}, + {?eh,start_info,{14,14,43}}, {?eh,tc_start,{cfg_error_1_SUITE,init_per_suite}}, {?eh,tc_done, @@ -405,7 +429,6 @@ test_events(cfg_error) -> {cfg_error_8_SUITE,{init_per_group,g3,[]}, {failed,{error,{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -415,7 +438,6 @@ test_events(cfg_error) -> {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -426,7 +448,6 @@ test_events(cfg_error) -> {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -520,16 +541,19 @@ test_events(cfg_error) -> %%! end_tc failes the testcase {?eh,tc_done,{cfg_error_9_SUITE,tc6,ok}}, {?eh,test_stats,{9,2,{0,18}}}, + {?eh,tc_start,{cfg_error_9_SUITE,tc7}}, + {?eh,tc_done,{cfg_error_9_SUITE,tc7,{failed,{error,tc7_should_be_failed}}}}, + {ct_test_support_eh,test_stats,{9,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc11}}, {?eh,tc_done,{cfg_error_9_SUITE,tc11, {failed,{cfg_error_9_SUITE,end_per_testcase, {'EXIT',warning_should_be_printed}}}}}, - {?eh,test_stats,{10,2,{0,18}}}, + {?eh,test_stats,{10,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc12}}, {?eh,tc_done,{cfg_error_9_SUITE,tc12, {failed,{cfg_error_9_SUITE,end_per_testcase, {timetrap_timeout,2000}}}}}, - {?eh,test_stats,{11,2,{0,18}}}, + {?eh,test_stats,{11,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc13}}, {?eh,tc_done,{cfg_error_9_SUITE,tc13, {failed,{cfg_error_9_SUITE,end_per_testcase, @@ -539,11 +563,11 @@ test_events(cfg_error) -> {test_server,do_end_per_testcase,4}, {test_server,run_test_case_eval1,6}, {test_server,run_test_case_eval,8}]}}}}}}, - {?eh,test_stats,{12,2,{0,18}}}, + {?eh,test_stats,{12,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc14}}, {?eh,tc_done, {cfg_error_9_SUITE,tc14,{failed,{error,tc14_should_be_failed}}}}, - {?eh,test_stats,{12,3,{0,18}}}, + {?eh,test_stats,{12,4,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_9_SUITE,end_per_suite,ok}}, @@ -554,7 +578,7 @@ test_events(cfg_error) -> {?eh,tc_auto_skip,{cfg_error_10_SUITE,tc1, {failed,{cfg_error_10_SUITE,init_per_suite, {failed,fail_init_per_suite}}}}}, - {?eh,test_stats,{12,3,{0,19}}}, + {?eh,test_stats,{12,4,{0,19}}}, {?eh,tc_auto_skip,{cfg_error_10_SUITE,end_per_suite, {failed,{cfg_error_10_SUITE,init_per_suite, {failed,fail_init_per_suite}}}}}, @@ -563,40 +587,40 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_11_SUITE,tc1}}, {?eh,tc_done,{cfg_error_11_SUITE,tc1, {skipped,{config_name_already_in_use,[dummy0]}}}}, - {?eh,test_stats,{12,3,{1,19}}}, + {?eh,test_stats,{12,4,{1,19}}}, {?eh,tc_start,{cfg_error_11_SUITE,tc2}}, {?eh,tc_done,{cfg_error_11_SUITE,tc2,ok}}, - {?eh,test_stats,{13,3,{1,19}}}, + {?eh,test_stats,{13,4,{1,19}}}, {?eh,tc_start,{cfg_error_11_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_12_SUITE,tc1}}, {?eh,tc_done,{cfg_error_12_SUITE,tc1,{failed,{timetrap_timeout,500}}}}, - {?eh,test_stats,{13,4,{1,19}}}, + {?eh,test_stats,{13,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc2}}, {?eh,tc_done,{cfg_error_12_SUITE,tc2,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{14,4,{1,19}}}, + {?eh,test_stats,{14,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc3}}, {?eh,tc_done,{cfg_error_12_SUITE,tc3,ok}}, - {?eh,test_stats,{15,4,{1,19}}}, + {?eh,test_stats,{15,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc4}}, {?eh,tc_done,{cfg_error_12_SUITE,tc4,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{16,4,{1,19}}}, + {?eh,test_stats,{16,5,{1,19}}}, {?eh,tc_start,{cfg_error_13_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_13_SUITE,tc1}}, {?eh,tc_done,{cfg_error_13_SUITE,tc1,ok}}, - {?eh,test_stats,{17,4,{1,19}}}, + {?eh,test_stats,{17,5,{1,19}}}, {?eh,tc_start,{cfg_error_13_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,tc1}}, {?eh,tc_done,{cfg_error_14_SUITE,tc1,ok}}, - {?eh,test_stats,{18,4,{1,19}}}, + {?eh,test_stats,{18,5,{1,19}}}, {?eh,tc_start,{cfg_error_14_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,end_per_suite, {comment, @@ -729,7 +753,7 @@ test_events(timetrap_normal) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{1,1,3}}, + {?eh,start_info,{1,1,4}}, {?eh,tc_start,{timetrap_2_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_2_SUITE,tc0}}, @@ -744,6 +768,9 @@ test_events(timetrap_normal) -> {?eh,tc_done, {timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, {?eh,test_stats,{0,3,{0,0}}}, + {?eh,tc_start,{timetrap_2_SUITE,tc3}}, + {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}}, + {?eh,test_stats,{1,3,{0,0}}}, {?eh,tc_start,{timetrap_2_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -754,7 +781,7 @@ test_events(timetrap_extended) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{1,1,3}}, + {?eh,start_info,{1,1,4}}, {?eh,tc_start,{timetrap_2_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_2_SUITE,tc0}}, @@ -769,8 +796,52 @@ test_events(timetrap_extended) -> {?eh,tc_done, {timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,1000}}}}, {?eh,test_stats,{0,3,{0,0}}}, + {?eh,tc_start,{timetrap_2_SUITE,tc3}}, + {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}}, + {?eh,test_stats,{1,3,{0,0}}}, {?eh,tc_start,{timetrap_2_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} - ]. + ]; + +test_events(timetrap_parallel) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,7}}, + {?eh,tc_done,{timetrap_3_SUITE,init_per_suite,ok}}, + {parallel, + [{?eh,tc_start, + {timetrap_3_SUITE,{init_per_group,g1,[parallel]}}}, + {?eh,tc_done, + {timetrap_3_SUITE,{init_per_group,g1,[parallel]},ok}}, + {?eh,tc_start,{timetrap_3_SUITE,tc0}}, + {?eh,tc_start,{timetrap_3_SUITE,tc1}}, + {?eh,tc_start,{timetrap_3_SUITE,tc2}}, + {?eh,tc_start,{timetrap_3_SUITE,tc3}}, + {?eh,tc_start,{timetrap_3_SUITE,tc4}}, + {?eh,tc_start,{timetrap_3_SUITE,tc6}}, + {?eh,tc_start,{timetrap_3_SUITE,tc7}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc1,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc2,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc6,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc7,{failed,{timetrap_timeout,1500}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc0,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc4,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc3,{failed,{timetrap_timeout,3000}}}}, + {?eh,test_stats,{0,7,{0,0}}}, + {?eh,tc_start, + {timetrap_3_SUITE,{end_per_group,g1,[parallel]}}}, + {?eh,tc_done, + {timetrap_3_SUITE,{end_per_group,g1,[parallel]},ok}}]}, + {?eh,tc_done,{timetrap_3_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl index d73287ad62..40b7d2da47 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl @@ -83,6 +83,8 @@ init_per_testcase(tc3, Config) -> Config; init_per_testcase(tc4, _) -> ok; +init_per_testcase(tc7, _) -> + {fail,tc7_should_be_failed}; init_per_testcase(_, Config) -> Config. @@ -136,7 +138,7 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc1,tc2,tc3,tc4,tc5,tc6, + [tc1,tc2,tc3,tc4,tc5,tc6,tc7, tc11,tc12,tc13,tc14]. tc1(_) -> @@ -171,6 +173,11 @@ tc6(_) -> ct:comment("This one should succeed but then get failed by end_tc!"), fini. +tc7(_) -> + ct:comment("This one should get failed by iptc!"), + fini. + + tc11(_) -> fini. tc12(_) -> diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl index 99bb400137..7fcb631d06 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl @@ -77,8 +77,8 @@ init_per_testcase(tc1, Config) -> ct:timetrap({seconds,1}), Config; -init_per_testcase(tc3, Config) -> - ct:timetrap({seconds,1}), +init_per_testcase(tc2, Config) -> + ct:timetrap(250), Config; init_per_testcase(_TestCase, Config) -> @@ -90,7 +90,7 @@ init_per_testcase(_TestCase, Config) -> %% TestCase = atom() %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- -end_per_testcase(_, Config) -> +end_per_testcase(_, _Config) -> ok. %%-------------------------------------------------------------------- @@ -116,7 +116,7 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc0,tc1,tc2]. + [tc0,tc1,tc2,tc3]. tc0(_) -> N = list_to_integer(ct:get_config(multiply)), @@ -131,8 +131,24 @@ tc1(_) -> ok. tc2(_) -> + ct:timetrap(500), N = list_to_integer(ct:get_config(multiply)), ct:comment(io_lib:format("TO after ~w sec", [0.5*N])), - ct:timetrap(500), ct:sleep(2000), ok. + +tc3() -> + [{timetrap,{seconds,2}}]. + +tc3(_) -> + T0 = now(), + ct:timetrap(infinity), + N = list_to_integer(ct:get_config(multiply)), + ct:comment(io_lib:format("Sleeping for ~w sec...", [4*N])), + ct:sleep(4000), + Diff = timer:now_diff(now(), T0), + if ((Diff < (N*4000000)) or (Diff > (N*4500000))) -> + exit(not_expected); + true -> + ok + end. diff --git a/lib/common_test/test/ct_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl index 5ef04c0e75..b534a7141d 100644 --- a/lib/common_test/test/ct_event_handler_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE.erl @@ -102,8 +102,9 @@ start_stop(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(start_stop, - ct_test_support:reformat(Events, eh_A), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, eh_A), + ?config(priv_dir, Config), + Opts), TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, @@ -148,8 +149,9 @@ results(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(results, - ct_test_support:reformat(Events, eh_A), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, eh_A), + ?config(priv_dir, Config), + Opts), TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl index 7775d8a55d..e520a72227 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl @@ -89,8 +89,9 @@ groups_suite_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suite_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -109,8 +110,9 @@ groups_suite_2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_2, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suite_2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -130,8 +132,9 @@ groups_suites_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suites_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suites_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -150,8 +153,9 @@ groups_dir_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_dir_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_dir_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -170,8 +174,9 @@ groups_dirs_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_dirs_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_dirs_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl index 2ae63f4f99..f33be8a9d4 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl @@ -59,7 +59,7 @@ end_per_testcase(TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [missing_conf, repeat_1]. + [missing_conf, repeat_1, empty_group]. groups() -> []. @@ -83,13 +83,14 @@ missing_conf(Config) when is_list(Config) -> Suite = filename:join(DataDir, "groups_1/missing_conf_SUITE"), - {Opts,ERPid} = setup({suite,Suite}, Config), + {Opts,ERPid} = setup([{suite,Suite}], Config), ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(missing_conf_SUITE, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(missing_conf), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -102,18 +103,41 @@ repeat_1(Config) when is_list(Config) -> Suite = filename:join(DataDir, "groups_1/repeat_1_SUITE"), - {Opts,ERPid} = setup({suite,Suite}, Config), + {Opts,ERPid} = setup([{suite,Suite}], Config), ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(repeat_1, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(repeat_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). %%%----------------------------------------------------------------- +%%% + +empty_group(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + Suite = filename:join(DataDir, "groups_2/groups_22_SUITE"), + + {Opts,ERPid} = setup([{suite,Suite}, + {group,[test_group_8,test_group_9,test_group_10]}], + Config), + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(empty_group, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(empty_group), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -121,7 +145,7 @@ setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], - Opts = Opts0 ++ [Test,{event_handler,{?eh,EvHArgs}}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test], ERPid = ct_test_support:start_event_receiver(Config), {Opts,ERPid}. @@ -256,4 +280,27 @@ test_events(repeat_1) -> {?eh,tc_done,{repeat_1_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} + ]; + +test_events(empty_group) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}}, + [{?eh,tc_start, + {groups_22_SUITE,{init_per_group,test_group_8,[]}}}, + {?eh,tc_done, + {groups_22_SUITE,{init_per_group,test_group_8,[]},ok}}, + {?eh,tc_start,{groups_22_SUITE,testcase_8}}, + {?eh,tc_done,{groups_22_SUITE,testcase_8,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start, + {groups_22_SUITE,{end_per_group,test_group_8,[]}}}, + {?eh,tc_done, + {groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}], + {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl index cd517876df..14eb8769ad 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl @@ -31,27 +31,33 @@ suite() -> groups() -> [ - {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]}, + {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]}, - {test_group_1b, [parallel], [testcase_1a,testcase_1b]}, + {test_group_1b, [parallel], [testcase_1a,testcase_1b]}, - {test_group_2, [parallel], [testcase_2a, + {test_group_2, [parallel], [testcase_2a, - {test_group_3, [{repeat,1}], - [testcase_3a, testcase_3b]}, + {test_group_3, [{repeat,1}], + [testcase_3a, testcase_3b]}, - testcase_2b]}, + testcase_2b]}, - {test_group_4, [{test_group_5, [parallel], [testcase_5a, + {test_group_4, [{test_group_5, [parallel], [testcase_5a, - {group, test_group_6}, + {group, test_group_6}, - testcase_5b]}]}, + testcase_5b]}]}, - {test_group_6, [parallel], [{group, test_group_7}]}, + {test_group_6, [parallel], [{group, test_group_7}]}, - {test_group_7, [sequence], [testcase_7a,testcase_7b]} - ]. + {test_group_7, [sequence], [testcase_7a,testcase_7b]}, + + {test_group_8, [], [{group, test_group_9}, testcase_8]}, + + {test_group_9, [], []}, + + {test_group_10, [], [{group, test_group_9}]} + ]. all() -> [{group, test_group_1a}, @@ -60,7 +66,10 @@ all() -> testcase_2, {group, test_group_2}, testcase_3, - {group, test_group_4}]. + {group, test_group_4}, + {group, test_group_8}, + {group, test_group_9}, + {group, test_group_10}]. %% this func only for internal test purposes grs_and_tcs() -> @@ -68,7 +77,9 @@ grs_and_tcs() -> test_group_1a, test_group_1b, test_group_2, test_group_3, test_group_4, test_group_5, - test_group_6, test_group_7 + test_group_6, test_group_7, + test_group_8, test_group_9, + test_group_10 ], [ testcase_1a, testcase_1b, testcase_1c, @@ -78,7 +89,8 @@ grs_and_tcs() -> testcase_3a, testcase_3b, testcase_3, testcase_5a, testcase_5b, - testcase_7a, testcase_7b + testcase_7a, testcase_7b, + testcase_8 ]}. %%-------------------------------------------------------------------- @@ -107,7 +119,10 @@ init_per_group(Group, Config) -> {test_group_4,[{name,test_group_4}]} -> ok; {test_group_5,[{name,test_group_5},parallel]} -> "parallel"; {test_group_6,[{name,test_group_6},parallel]} -> "parallel"; - {test_group_7,[{name,test_group_7},sequence]} -> "sequence" + {test_group_7,[{name,test_group_7},sequence]} -> "sequence"; + {test_group_8,[{name,test_group_8}]} -> ok; + {test_group_9,[{name,test_group_9}]} -> ok; + {test_group_10,[{name,test_group_10}]} -> ok end, {Grs,_} = grs_and_tcs(), case lists:member(Group, Grs) of @@ -312,3 +327,7 @@ testcase_7b(Config) -> undefined = ?config(testcase_7a,Config), testcase_7b = ?config(testcase_7b,Config), ok. +testcase_8() -> + []. +testcase_8(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 64f4e277ff..be1c02f163 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -225,8 +225,9 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(Tag, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(Tag, EC), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -259,9 +260,9 @@ events_to_check(Test, N) -> test_events(one_empty_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{empty_cth,id,[[]]}}, {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{empty_cth,pre_init_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -287,11 +288,11 @@ test_events(one_empty_cth) -> test_events(two_empty_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -329,8 +330,8 @@ test_events(faulty_cth_no_init) -> test_events(faulty_cth_id_no_init) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',id,[[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',id,[[]]}}, {negative,{?eh,tc_start,'_'}, {?eh,test_done,{'DEF','STOP_TIME'}}}, {?eh,stop_logging,[]} @@ -339,9 +340,9 @@ test_events(faulty_cth_id_no_init) -> test_events(minimal_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {negative,{?eh,cth,{'_',id,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, @@ -357,11 +358,11 @@ test_events(minimal_cth) -> test_events(minimal_and_maximal_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {negative,{?eh,cth,{'_',id,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -387,8 +388,8 @@ test_events(faulty_cth_undef) -> {failed,FailReasonStr}}, [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed, {error,FailReasonStr}}}}, @@ -433,15 +434,15 @@ test_events(faulty_cth_exit_in_init_scope_suite) -> test_events(faulty_cth_exit_in_init) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[]]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; test_events(faulty_cth_exit_in_id) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,id,[[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, {negative, {?eh,tc_start,'_'}, {?eh,test_done,{'DEF','STOP_TIME'}}}, {?eh,stop_logging,[]}]; @@ -609,9 +610,8 @@ test_events(scope_per_group_state_cth) -> test_events(fail_pre_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -649,8 +649,8 @@ test_events(fail_pre_suite_cth) -> test_events(fail_post_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -676,8 +676,8 @@ test_events(fail_post_suite_cth) -> test_events(skip_pre_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}}, @@ -699,8 +699,8 @@ test_events(skip_pre_suite_cth) -> test_events(skip_post_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -724,8 +724,8 @@ test_events(recover_post_suite_cth) -> Suite = ct_cth_fail_per_suite_SUITE, [ {?eh,start_logging,'_'}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{Suite,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[Suite,'$proplist','$proplist']}}, {?eh,cth,{'_',post_init_per_suite,[Suite,contains([tc_status]), @@ -753,8 +753,8 @@ test_events(recover_post_suite_cth) -> test_events(update_config_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, @@ -864,9 +864,9 @@ test_events(update_config_cth) -> test_events(state_update_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{'_',init_per_suite}}, {?eh,tc_done,{'_',end_per_suite,ok}}, @@ -902,8 +902,8 @@ test_events(state_update_cth) -> test_events(options_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,init,['_',[test]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[test]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{empty_cth,pre_init_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -929,10 +929,10 @@ test_events(options_cth) -> test_events(same_id_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,[same_id_cth,[]]}}, {?eh,cth,{'_',id,[[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -969,8 +969,8 @@ test_events(same_id_cth) -> test_events(fail_n_skip_with_minimal_cth) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, {?eh,tc_done,{'_',end_per_suite,ok}}, diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index e89b6f7de6..1471cc1e0c 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -119,8 +119,9 @@ ct_master_test(Config) when is_list(Config)-> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + PrivDir, []), + find_events(NodeNames, [{tc_start,{master_SUITE,init_per_suite}}, {tc_start,{master_SUITE,first_testcase}}, {tc_start,{master_SUITE,second_testcase}}, @@ -174,7 +175,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config)-> ct_test_support:write_testspec(N++Include++EH++C++S++LD++NS, FileName). -get_log_dir({win32,_},PrivDir, NodeName)-> +get_log_dir({win32,_}, _PrivDir, NodeName)-> case filelib:is_dir(?TEMP_DIR) of false -> file:make_dir(?TEMP_DIR); diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl index a8bd2c2189..cb17af9ab5 100644 --- a/lib/common_test/test/ct_misc_1_SUITE.erl +++ b/lib/common_test/test/ct_misc_1_SUITE.erl @@ -111,7 +111,8 @@ beam_me_up(Config) when is_list(Config) -> ct_test_support:log_events(beam_me_up, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(beam_me_up, 1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index e674315526..4e842bd6d6 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -159,7 +159,8 @@ execute(TestCase, SuiteName, Group, Config) -> ct_test_support:log_events(TestCase, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TestCase), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -561,7 +562,6 @@ test_events(repeat_cs_until_any_fail) -> {error, {{badmatch,2}, [{repeat_1_SUITE,tc_fail_1,1}, - {repeat_1_SUITE,tc_fail_1,1}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl index c7650b169c..5facf90656 100644 --- a/lib/common_test/test/ct_sequence_1_SUITE.erl +++ b/lib/common_test/test/ct_sequence_1_SUITE.erl @@ -132,7 +132,8 @@ execute(TestCase, SuiteName, Group, Config) -> ct_test_support:log_events(TestCase, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TestCase), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl index 62c5f10b7c..4ba4479208 100644 --- a/lib/common_test/test/ct_skip_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE.erl @@ -99,8 +99,9 @@ auto_skip(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(auto_skip, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(auto_skip), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -122,8 +123,9 @@ user_skip(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(user_skip, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(user_skip), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl index c3d49a5afa..49b38361e2 100644 --- a/lib/common_test/test/ct_smoke_test_SUITE.erl +++ b/lib/common_test/test/ct_smoke_test_SUITE.erl @@ -175,8 +175,9 @@ dir1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir1, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -204,8 +205,9 @@ dir2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir2, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -234,8 +236,9 @@ dir1_2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir1_2, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir1_2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -264,8 +267,8 @@ suite11(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite11, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite11), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -293,8 +296,8 @@ suite21(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite21, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite21), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -324,8 +327,8 @@ suite11_21(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite11_21, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite11_21), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -355,8 +358,8 @@ tc111(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc111, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc111), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -385,8 +388,8 @@ tc211(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc211, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc211), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -416,8 +419,8 @@ tc111_112(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc111_112, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc111_112), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index 9d3e6a9e59..4471915e69 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -98,8 +98,9 @@ ts_if_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(ts_if_1, - reformat(Events, ?eh), - PrivDir), + reformat(Events, ?eh), + PrivDir, + Opts), TestEvents = events_to_check(ts_if_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index b4f1a0e71f..601d5315ce 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -32,7 +32,8 @@ run/2, run/4, get_opts/1, wait_for_ct_stop/1]). -export([handle_event/2, start_event_receiver/1, get_events/2, - verify_events/3, reformat/2, log_events/3]). + verify_events/3, reformat/2, log_events/4, + join_abs_dirs/2]). -include_lib("kernel/include/file.hrl"). @@ -63,7 +64,6 @@ init_per_suite(Config, Level) -> start_slave(Config,Level) -> [_,Host] = string:tokens(atom_to_list(node()), "@"), - test_server:format(0, "Trying to start ~s~n", ["ct@"++Host]), case slave:start(Host, ct, []) of {error,Reason} -> @@ -72,18 +72,19 @@ start_slave(Config,Level) -> test_server:format(0, "Node ~p started~n", [CTNode]), IsCover = test_server:is_cover(), if IsCover -> - cover:start(CTNode); - true-> - ok + cover:start(CTNode); + true-> + ok end, - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), %% PrivDir as well as directory of Test Server suites %% have to be in code path on Common Test node. [_ | Parts] = lists:reverse(filename:split(DataDir)), TSDir = filename:join(lists:reverse(Parts)), - AddPathDirs = case ?config(path_dirs, Config) of + AddPathDirs = case proplists:get_value(path_dirs, Config) of undefined -> []; Ds -> Ds end, @@ -110,8 +111,8 @@ start_slave(Config,Level) -> %%% end_per_suite/1 end_per_suite(Config) -> - CTNode = ?config(ct_node, Config), - PrivDir = ?config(priv_dir, Config), + CTNode = proplists:get_value(ct_node, Config), + PrivDir = proplists:get_value(priv_dir, Config), true = rpc:call(CTNode, code, del_path, [filename:join(PrivDir,"")]), cover:stop(CTNode), slave:stop(CTNode), @@ -121,7 +122,9 @@ end_per_suite(Config) -> %%% init_per_testcase/2 init_per_testcase(_TestCase, Config) -> - {_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)), + Opts = get_opts(Config), + NetDir = proplists:get_value(net_dir, Opts), + LogDir = join_abs_dirs(NetDir, proplists:get_value(logdir, Opts)), case lists:keysearch(master, 1, Config) of false-> test_server:format("See Common Test logs here:\n\n" @@ -139,7 +142,7 @@ init_per_testcase(_TestCase, Config) -> %%% end_per_testcase/2 end_per_testcase(_TestCase, Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), case wait_for_ct_stop(CTNode) of %% Common test was not stopped to we restart node. false -> @@ -169,7 +172,7 @@ write_testspec(TestSpec, TSFile) -> %%% get_opts(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), TempDir = case os:getenv("TMP") of false -> case os:getenv("TEMP") of @@ -195,20 +198,48 @@ get_opts(Config) -> _ -> TempDir end, - InitOpts = ?config(ct_opts, Config), - [{logdir,LogDir} | InitOpts]. + + %% Copy test variables to app environment on new node + CtTestVars = + case init:get_argument(ct_test_vars) of + {ok,[Vars]} -> + [begin {ok,Ts,_} = erl_scan:string(Str++"."), + {ok,Expr} = erl_parse:parse_term(Ts), + Expr + end || Str <- Vars]; + _ -> + [] + end, + %% test_server:format("Test variables added to Config: ~p\n\n", + %% [CtTestVars]), + InitOpts = + case proplists:get_value(ct_opts, Config) of + undefined -> []; + CtOpts -> CtOpts + end, + [{logdir,LogDir} | InitOpts ++ CtTestVars]. %%%----------------------------------------------------------------- %%% run(Opts, Config) -> - CTNode = ?config(ct_node, Config), - Level = ?config(trace_level, Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), %% use ct interface test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n", [Opts, CTNode]), Result1 = rpc:call(CTNode, ct, run_test, [Opts]), + case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of + undefined -> + ok; + _ -> + test_server:format(Level, + "ct_util_server not stopped on ~p yet, waiting 5 s...~n", + [CTNode]), + timer:sleep(5000), + undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) + end, %% use run_test interface (simulated) test_server:format(Level, "Saving start opts on ~p: ~p~n", [CTNode,Opts]), rpc:call(CTNode, application, set_env, [common_test, run_test_start_opts, Opts]), @@ -224,8 +255,8 @@ run(Opts, Config) -> end. run(M, F, A, Config) -> - CTNode = ?config(ct_node, Config), - Level = ?config(trace_level, Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), test_server:format(Level, "~nCalling ~w:~w(~p) on ~p~n", [M, F, A, CTNode]), rpc:call(CTNode, M, F, A). @@ -261,11 +292,11 @@ handle_event(EH, Event) -> ok. start_event_receiver(Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), spawn_link(CTNode, fun() -> er() end). get_events(_, Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), {event_receiver,CTNode} ! {self(),get_events}, Events = receive {event_receiver,Evs} -> Evs end, {event_receiver,CTNode} ! stop, @@ -288,7 +319,7 @@ er_loop(Evs) -> end. verify_events(TEvs, Evs, Config) -> - Node = ?config(ct_node, Config), + Node = proplists:get_value(ct_node, Config), case catch verify_events1(TEvs, Evs, Node, Config) of {'EXIT',Reason} -> Reason; @@ -349,10 +380,15 @@ locate(TEvs, Node, Evs, Config) when is_list(TEvs) -> data={M,{init_per_group,GroupName,Props}}}}, {TEH,#event{name=tc_done, node=Node, - data={M,{init_per_group,GroupName,Props},R}}} | Evs1] -> - test_server:format("Found ~p!", [InitStart]), - test_server:format("Found ~p!", [InitDone]), - verify_events1(TEvs1, Evs1, Node, Config); + data={M,{init_per_group,GroupName,Props},Res}}} | Evs1] -> + case result_match(R, Res) of + false -> + nomatch; + true -> + test_server:format("Found ~p!", [InitStart]), + test_server:format("Found ~p!", [InitDone]), + verify_events1(TEvs1, Evs1, Node, Config) + end; _ -> nomatch end; @@ -384,9 +420,11 @@ locate({parallel,TEvs}, Node, Evs, Config) -> EvProps},EvR}}}) when TEH == EH, EvNode == Node, EvM == M, EvGroupName == GroupName, - EvProps == Props, - EvR == R -> - false; + EvProps == Props -> + case result_match(R, EvR) of + true -> false; + false -> true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -466,7 +504,7 @@ locate({parallel,TEvs}, Node, Evs, Config) -> node=EvNode, data={Mod,Func,Result}}} <- Done, EH == TEH, EvNode == Node, Mod == M, - Func == F, Result == R] of + Func == F, result_match(R, Result)] of [TcDone|_] -> test_server:format("Found ~p!", [TEv]), {lists:delete(TcDone, Done),RemEvs,RemSize}; @@ -509,8 +547,13 @@ locate({parallel,TEvs}, Node, Evs, Config) -> data={Mod,{end_per_group, EvGName,EvProps},Res}}}) when EH == TEH, EvNode == Node, Mod == M, - EvGName == GroupName, EvProps == Props, Res == R -> - false; + EvGName == GroupName, EvProps == Props -> + case result_match(R, Res) of + true -> + false; + false -> + true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -603,23 +646,29 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> data={M,{init_per_group,GroupName,EvProps}}}}, {TEH,#event{name=tc_done, node=Node, - data={M,{init_per_group,GroupName,EvProps},R}}} | Es] -> - case proplists:get_value(shuffle, Props) of - '_' -> - case proplists:get_value(shuffle, EvProps) of - false -> - exit({no_shuffle_prop_found,{M,init_per_group, - GroupName,EvProps}}); + data={M,{init_per_group,GroupName,EvProps},Res}}} | Es] -> + case result_match(R, Res) of + true -> + case proplists:get_value(shuffle, Props) of + '_' -> + case proplists:get_value(shuffle, EvProps) of + false -> + exit({no_shuffle_prop_found, + {M,init_per_group, + GroupName,EvProps}}); + _ -> + PropsCmp = proplists:delete(shuffle, EvProps), + PropsCmp = proplists:delete(shuffle, Props) + end; _ -> - PropsCmp = proplists:delete(shuffle, EvProps), - PropsCmp = proplists:delete(shuffle, Props) - end; - _ -> - Props = EvProps - end, - test_server:format("Found ~p!", [InitStart]), - test_server:format("Found ~p!", [InitDone]), - {TEs,Es}; + Props = EvProps + end, + test_server:format("Found ~p!", [InitStart]), + test_server:format("Found ~p!", [InitDone]), + {TEs,Es}; + false -> + nomatch + end; _ -> nomatch end; @@ -670,7 +719,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> node=EvNode, data={Mod,Func,Result}}} <- Done, EH == TEH, EvNode == Node, Mod == M, - Func == F, Result == R] of + Func == F, result_match(R, Result)] of [TcDone|_] -> test_server:format("Found ~p!", [TEv]), {lists:delete(TcDone, Done),RemEvs,RemSize}; @@ -726,8 +775,13 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> data={Mod,{end_per_group, EvGName,_},Res}}}) when EH == TEH, EvNode == Node, Mod == M, - EvGName == GroupName, Res == R -> - false; + EvGName == GroupName -> + case result_match(R, Res) of + true -> + false; + false -> + true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -864,25 +918,34 @@ locate({TEH,Name,{'DEF','STOP_TIME'}}, Node, [Ev|Evs], Config) -> nomatch end; -%% to match variable data as a result of a failed test case -locate({TEH,tc_done,{Mod,Func,{failed,{error,{Slogan,'_'}}}}}, Node, [Ev|Evs], Config) -> +%% to match variable data as a result of an aborted test case +locate({TEH,tc_done,{undefined,undefined,{testcase_aborted, + {abort_current_testcase,Func},'_'}}}, + Node, [Ev|Evs], Config) -> case Ev of - {TEH,#event{name=tc_done, node=Node, - data={Mod,Func,{failed,{error,{Slogan,_}}}}}} -> + {TEH,#event{name=tc_done, node=Node, + data={undefined,undefined, + {testcase_aborted,{abort_current_testcase,Func},_}}}} -> {Config,Evs}; _ -> nomatch end; -%% to match variable data as a result of an aborted test case -locate({TEH,tc_done,{undefined,undefined,{testcase_aborted, - {abort_current_testcase,Func},'_'}}}, - Node, [Ev|Evs], Config) -> +%% to match variable data as a result of a failed test case +locate({TEH,tc_done,{Mod,Func,R={SkipOrFail,{_ErrInd,ErrInfo}}}}, + Node, [Ev|Evs], Config) when ((SkipOrFail == skipped) or + (SkipOrFail == failed)) and + ((size(ErrInfo) == 2) or + (size(ErrInfo) == 3)) -> case Ev of {TEH,#event{name=tc_done, node=Node, - data={undefined,undefined, - {testcase_aborted,{abort_current_testcase,Func},_}}}} -> - {Config,Evs}; + data={Mod,Func,Result}}} -> + case result_match(R, Result) of + true -> + {Config,Evs}; + false -> + nomatch + end; _ -> nomatch end; @@ -931,14 +994,27 @@ match_data(Tuple1,Tuple2) when is_tuple(Tuple1),is_tuple(Tuple2) -> match_data([],[]) -> match. -log_events(TC, Events, PrivDir) -> - LogFile = filename:join(PrivDir, atom_to_list(TC)++".events"), +result_match({SkipOrFail,{ErrorInd,{Why,'_'}}}, + {SkipOrFail,{ErrorInd,{Why,_Stack}}}) -> + true; +result_match({SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,'_'}}}}, + {SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,_Stack}}}}) -> + true; +result_match(Result, Result) -> + true; +result_match(_, _) -> + false. + +log_events(TC, Events, EvLogDir, Opts) -> + LogFile = filename:join(EvLogDir, atom_to_list(TC)++".events"), {ok,Dev} = file:open(LogFile, [write]), io:format(Dev, "[~n", []), log_events1(Events, Dev, " "), file:close(Dev), + FullLogFile = join_abs_dirs(proplists:get_value(net_dir, Opts), + LogFile), io:format("Events written to logfile: <a href=\"file://~s\">~s</a>~n", - [LogFile,LogFile]), + [FullLogFile,FullLogFile]), io:format(user, "Events written to logfile: ~p~n", [LogFile]). log_events1(Evs, Dev, "") -> @@ -1024,13 +1100,25 @@ reformat([], _EH) -> %%%----------------------------------------------------------------- %%% MISC HELP FUNCTIONS +join_abs_dirs(undefined, Dir2) -> + Dir2; +join_abs_dirs(Dir1, Dir2) -> + case filename:pathtype(Dir2) of + relative -> + filename:join(Dir1, Dir2); + _ -> + [_Abs|Parts] = filename:split(Dir2), + filename:join(Dir1, filename:join(Parts)) + end. + create_tmp_logdir(Tmp) -> LogDir = filename:join(Tmp,"ct"), file:make_dir(LogDir), LogDir. delete_old_logs({win32,_}, Config) -> - case {?config(priv_dir, Config),?config(logdir, get_opts(Config))} of + case {proplists:get_value(priv_dir, Config), + proplists:get_value(logdir, get_opts(Config))} of {LogDir,LogDir} -> ignore; {_,LogDir} -> % using tmp for logs @@ -1042,7 +1130,8 @@ delete_old_logs(_, Config) -> false -> ignore; _ -> - catch delete_dirs(?config(logdir, get_opts(Config))) + catch delete_dirs(proplists:get_value(logdir, + get_opts(Config))) end. delete_dirs(LogDir) -> diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index 616c2db869..b6dcf63fdf 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -612,6 +612,12 @@ setup_and_execute(TCName, TestSpec, Config) -> false -> [{spec,SpecFile},{label,TCName}] end, {Opts,ERPid} = setup(TestTerms, Config), + + FullSpecFile = ct_test_support:join_abs_dirs(?config(net_dir, Opts), + SpecFile), + io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n", + [FullSpecFile,FullSpecFile]), + ok = ct_test_support:run(Opts, Config), TestSpec1 = [{logdir,proplists:get_value(logdir,Opts)}, {label,proplists:get_value(label,TestTerms)} | TestSpec], @@ -620,7 +626,8 @@ setup_and_execute(TCName, TestSpec, Config) -> ct_test_support:log_events(TCName, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TCName), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -631,8 +638,6 @@ create_spec_file(SpecDir, TCName, TestSpec) -> {ok,Dev} = file:open(FileName, [write]), [io:format(Dev, "~p.~n", [Term]) || Term <- TestSpec], file:close(Dev), - io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n", - [FileName,FileName]), FileName. setup(Test, Config) when is_tuple(Test) -> @@ -791,7 +796,9 @@ test_events(skip_group) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}}, - {?eh,test_stats,{2,0,{1,0}}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_2},"SKIPPED!"}}, + %%! But not test_group_7 since it's a sub-group! + {?eh,test_stats,{2,0,{2,0}}}, {negative,{?eh,tc_user_skip,'_'},{?eh,stop_logging,'_'}} ]; @@ -1188,10 +1195,9 @@ test_events(sub_skipped_by_top) -> {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, - {negative, - {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 2a36fda1ea..5cc8252b99 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) -> warning_translate_label(Term, D) when is_tuple(Term) -> case element(1, Term) of {label,F} -> - case gb_trees:lookup(F, D) of - none -> Term; - {value,FA} -> setelement(1, Term, FA) - end; + FA = gb_trees:get(F, D), + setelement(1, Term, FA); _ -> Term end; warning_translate_label(Term, _) -> Term. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index bb93110176..8e96569414 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% We must split the basic block when we encounter instructions with labels, %% such as catches and BIFs. All labels must be visible outside the blocks. -%% Also remove empty blocks. split_blocks({function,Name,Arity,CLabel,Is0}) -> Is = split_blocks(Is0, []), {function,Name,Arity,CLabel,Is}. -split_blocks([{block,[]}|Is], Acc) -> - split_blocks(Is, Acc); split_blocks([{block,Bl}|Is], Acc0) -> Acc = split_block(Bl, [], Acc0), split_blocks(Is, Acc); @@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) -> D = update_value_dict(List, Reg, D0), forward(Is, D, Lc, [I|Acc]); forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Block = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Blk; %Must keep move instruction. - true -> {block,BlkIs} %Safe to remove move instruction. - end; - _ -> Blk %Keep move instruction. + {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction. + _ -> Blk %Must keep move instruction. end, forward([Block|Is], D, Lc, [LblI|Acc]); forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Is = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Is0; %Must keep move instruction. - true -> Is1 %Safe to remove move instruction. - end; - _ -> Is0 %Keep move instruction. - end, + {value,Lit} -> Is1; %Safe to remove move instruction. + _ -> Is0 %Keep move instruction. + end, forward(Is, D, Lc, [LblI|Acc]); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> @@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> Key = {Lbl,Reg}, D = case gb_trees:lookup(Key, D0) of none -> gb_trees:insert(Key, Lit, D0); %New. - {value,Lit} -> D0; %Already correct. {value,inconsistent} -> D0; %Inconsistent. {value,_} -> gb_trees:update(Key, inconsistent, D0) end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. -is_unreachable_after([I|_]) -> - beam_jump:is_unreachable_after(I). - %%% %%% Scan instructions in reverse execution order and remove dead code. %%% @@ -602,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> %% The save point we are looking for - we are done. Bits; -count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) -> - %% Another save point - keep counting. - count_bits_matched(Is, SavePoint, Bits); count_bits_matched([_|_], _, Bits) -> Bits. shortcut_bs_pos_used(To, Reg, D) -> shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). -shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) -> - false; shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> false; shortcut_bs_pos_used_1(Is, Reg, D) -> diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index cab22e03d0..f7388f1614 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(andor_SUITE), + test_lib:recompile(?MODULE), [t_case, t_and_or, t_andalso, t_orelse, inside, overlap, combined, in_case, before_and_inside_if]. diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index c517c4465e..25f8a8dfb5 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(apply_SUITE), + test_lib:recompile(?MODULE), [mfa, fun_apply]. groups() -> diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index fc88ebeb41..556dc54a8f 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -46,7 +46,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(beam_validator_SUITE), + test_lib:recompile(?MODULE), [beam_files, compiler_bug, stupid_but_valid, xrange, yrange, stack, call_last, merge_undefined, uninit, unsafe_catch, dead_code, mult_labels, diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 30c04f80cf..d39e340429 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bincomp_SUITE), + test_lib:recompile(?MODULE), [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, nomatch, sizes, tail]. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index 8be0c4196a..30276f1259 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bit_binaries_SUITE), + test_lib:recompile(?MODULE), [misc, horrid_match, test_bitstr, test_bit_size, asymmetric_tests, big_asymmetric_tests, binary_to_and_from_list, big_binary_to_and_from_list, diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index c430b12b70..31c7890f26 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_construct_SUITE), + test_lib:recompile(?MODULE), [two, test1, fail, float_bin, in_guard, in_catch, nasty_literals, side_effect, opt, otp_7556, float_arith, otp_8054]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 9184e14cb2..6a795f6634 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -35,7 +35,7 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1]). --export([coverage_id/1]). +-export([coverage_id/1,coverage_external_ignore/2]). -include_lib("test_server/include/test_server.hrl"). @@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_match_SUITE), + test_lib:recompile(?MODULE), [fun_shadow, int_float, otp_5269, null_fields, wiger, bin_tail, save_restore, shadowed_size_var, partitioned_bs_match, function_clause, unit, @@ -585,13 +585,17 @@ coverage(Config) when is_list(Config) -> A+B end, 0, [a,b,c])), + ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float), ?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple), ?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} = coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}), + ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []), + ?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}), ?line [42] = coverage_apply(<<42>>, [coverage_id]), + ?line 42 = coverage_external(<<42>>), ?line do_coverage_bin_to_term_list([]), ?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]), @@ -608,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) -> coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T); coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc. +coverage_build(Acc0, <<H,T/binary>>, float) -> + Float = id(<<H:64/float>>), + Acc = <<Acc0/binary,Float/binary>>, + coverage_build(Acc, T, float); coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> Str = id(<<H:(id(4)),(H-1):4,"abc">>), Acc = id(<<Acc0/bitstring,Str/bitstring>>), @@ -618,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> end; coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}. +coverage_bc(<<H,T/binary>>, Acc) -> + B = << <<C:8>> || C <- [H] >>, + coverage_bc(T, [B|Acc]); +coverage_bc(<<>>, Acc) -> Acc. + coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x -> setelement(H, Tuple, T1). @@ -625,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) -> [?MODULE:F(H)|coverage_apply(T, Fs)]; coverage_apply(<<>>, []) -> []. +coverage_external(<<H,T/binary>>) -> + ?MODULE:coverage_external_ignore(T, T), + H. + +coverage_external_ignore(_, _) -> + ok. + coverage_id(I) -> id(I). do_coverage_bin_to_term_list(L) -> diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index d37943ce3a..f30a4d3fef 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_utf_SUITE), + test_lib:recompile(?MODULE), [utf8_roundtrip, unused_utf_char, utf16_roundtrip, utf32_roundtrip, guard, extreme_tripping, literals, coverage]. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index ba225b66d0..1343fbd1c9 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(compilation_SUITE), + test_lib:recompile(?MODULE), [self_compile_old_inliner, self_compile, compiler_1, compiler_3, compiler_5, beam_compiler_1, beam_compiler_2, beam_compiler_3, beam_compiler_4, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 037c078fd0..b3e5376ffd 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> all_return_type(). all() -> - test_lib:recompile(compile_SUITE), + test_lib:recompile(?MODULE), [app_test, file_1, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, package_forms, encrypted_abstr, diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 21a5f65dee..26173c62b8 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -40,7 +40,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_SUITE), + test_lib:recompile(?MODULE), [dehydrated_itracer, nested_tries]. groups() -> diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 710751b09d..ac14d36e82 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_fold_SUITE), + test_lib:recompile(?MODULE), [t_element, setelement, t_length, append, t_apply, bifs, eq, nested_call_in_case, coverage]. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index c9823665b4..6e0aadf007 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(error_SUITE), + test_lib:recompile(?MODULE), [head_mismatch_line, warnings_as_errors, bif_clashes]. groups() -> diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 6738265776..afc04fd440 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -26,7 +26,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(float_SUITE), + test_lib:recompile(?MODULE), [pending, bif_calls, math_functions, mixed_float_and_int]. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index aa9be83c82..368a5815bf 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(fun_SUITE), + test_lib:recompile(?MODULE), [test1, overwritten_fun, otp_7202, bif_fun]. groups() -> diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 482564a32b..0e69efba6b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -37,7 +37,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(guard_SUITE), + test_lib:recompile(?MODULE), [misc, const_cond, basic_not, complex_not, nested_nots, semicolon, complex_semicolon, comma, or_guard, more_or_guards, complex_or_guards, and_guard, xor_guard, diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 7b9600c2f6..af2b8ec92a 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(inline_SUITE), + test_lib:recompile(?MODULE), [attribute, bsdecode, bsdes, barnes2, decode1, smith, itracer, pseudoknot, lists, really_inlined, otp_7223, coverage]. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index bcdcf2fd9f..c8908858ba 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(lc_SUITE), + test_lib:recompile(?MODULE), [basic, deeply_nested, no_generator, empty_generator]. groups() -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 04879300d1..9406d7de8f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,16 +22,16 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1]). + selectify/1,underscore/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(match_SUITE), + test_lib:recompile(?MODULE), [pmatch, mixed, aliases, match_in_call, untuplify, - shortcut_boolean, letify_guard, selectify, underscore]. + shortcut_boolean, letify_guard, selectify, underscore, coverage]. groups() -> []. @@ -398,4 +398,18 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +coverage(Config) when is_list(Config) -> + %% Cover beam_dead. + ok = coverage_1(x, a), + ok = coverage_1(x, b). + +coverage_1(B, Tag) -> + case Tag of + a -> coverage_2(1, a, B); + b -> coverage_2(2, b, B) + end. + +coverage_2(1, a, x) -> ok; +coverage_2(2, b, x) -> ok. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index f1f9b17084..c941a80e61 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> misc_SUITE_test_cases(). all() -> - test_lib:recompile(misc_SUITE), + test_lib:recompile(?MODULE), [tobias, empty_string, md5, silly_coverage, confused_literals, integer_encoding, override_bif]. diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index 0a4750dc08..3479cf5425 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(num_bif_SUITE), + test_lib:recompile(?MODULE), [t_abs, t_float, t_float_to_list, t_integer_to_list, {group, t_list_to_float}, t_list_to_integer, t_round, t_trunc]. diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 4c68d777ca..9a317b5762 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(pmod_SUITE), + test_lib:recompile(?MODULE), [basic, otp_8447]. groups() -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 75e8045693..2a67615e5e 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -39,7 +39,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(receive_SUITE), + test_lib:recompile(?MODULE), [recv, coverage, otp_7980, ref_opt, export]. groups() -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 65b96590ed..363422ec7e 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -26,7 +26,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, - guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, nested_access/1]). + guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, + nested_access/1,coverage/1]). init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), @@ -40,10 +41,10 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(record_SUITE), + test_lib:recompile(?MODULE), [errors, record_test_2, record_test_3, record_access_in_guards, guard_opt, eval_once, foobar, - missing_test_heap, nested_access]. + missing_test_heap, nested_access, coverage]. groups() -> []. @@ -568,4 +569,18 @@ nested_access(Config) when is_list(Config) -> ?line N2a = N2b, ok. +-record(rr, {a,b,c}). + +coverage(Config) when is_list(Config) -> + %% There should only remain one record test in the code below. + R0 = id(#rr{a=1,b=2,c=3}), + B = R0#rr.b, %Test the record here. + R = R0#rr{c=42}, %No need to test here. + if + B > R#rr.a -> %No need to test here. + ok + end, + #rr{a=1,b=2,c=42} = id(R), %Test for correctness. + ok. + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 92a79d3cba..c6e0f8d85d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(trycatch_SUITE), + test_lib:recompile(?MODULE), [basic, lean_throw, try_of, try_after, catch_oops, after_oops, eclectic, rethrow, nested_of, nested_catch, nested_after, nested_horrid, last_call_optimization, diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index dd18a6e1a3..f6a572abfa 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -54,7 +54,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(warnings_SUITE), + test_lib:recompile(?MODULE), [pattern, pattern2, pattern3, pattern4, guard, bad_arith, bool_cases, bad_apply, files, effect, bin_opt_info, bin_construction]. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b8786f6f94..3ebf62d87c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,7 +134,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -204,7 +206,9 @@ static ErlNifFunc nif_funcs[] = { {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, {"rand_bytes", 1, rand_bytes_1}, + {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, {"rand_bytes", 3, rand_bytes_3}, + {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 3, mod_exp_nif}, {"dss_verify", 4, dss_verify}, @@ -704,6 +708,22 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); return ret; } +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes) */ + unsigned bytes; + unsigned char* data; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes)) { + return enif_make_badarg(env); + } + data = enif_make_new_binary(env, bytes, &ret); + if ( RAND_bytes(data, bytes) != 1) { + return atom_false; + } + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); + return ret; +} + static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes, TopMask, BottomMask) */ unsigned bytes; @@ -724,6 +744,47 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } return ret; } +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes, TopMask, BottomMask) */ + unsigned bits; + BIGNUM *bn_rand; + int top, bottom; + unsigned char* data; + unsigned dlen; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bits) + || !enif_get_int(env, argv[1], &top) + || !enif_get_int(env, argv[2], &bottom)) { + return enif_make_badarg(env); + } + if (! (top == -1 || top == 0 || top == 1) ) { + return enif_make_badarg(env); + } + if (! (bottom == 0 || bottom == 1) ) { + return enif_make_badarg(env); + } + + bn_rand = BN_new(); + if (! bn_rand ) { + return enif_make_badarg(env); + } + + /* Get a (bits) bit random number */ + if (!BN_rand(bn_rand, bits, top, bottom)) { + ret = atom_false; + } + else { + /* Copy the bignum into an erlang mpint binary. */ + dlen = BN_num_bytes(bn_rand); + data = enif_make_new_binary(env, dlen+4, &ret); + put_int32(data, dlen); + BN_bn2bin(bn_rand, data+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); + } + BN_free(bn_rand); + + return ret; +} static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index dfafe67348..1ccea6df79 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -619,6 +619,21 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> + <type> + <v>N = integer()</v> + </type> + <desc> + <p>Generates N bytes randomly uniform 0..255, and returns the + result in a binary. Uses a cryptographically secure prng seeded and + periodically mixed with operating system provided entropy. By default + this is the <c>RAND_bytes</c> method from OpenSSL.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>rand_uniform(Lo, Hi) -> N</name> <fsummary>Generate a random number</fsummary> <type> @@ -633,6 +648,31 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name> + <fsummary>Generate an N bit random number</fsummary> + <type> + <v>N = non_neg_integer()</v> + <v>Top = -1 | 0 | 1</v> + <v>Bottom = 0 | 1</v> + <v>Mpint = binary()</v> + </type> + <desc> + <p>Generate an N bit random number using OpenSSL's + cryptographically strong pseudo random number generator + <c>BN_rand</c>.</p> + <p>The parameter <c>Top</c> places constraints on the most + significant bits of the generated number. If <c>Top</c> is 1, then the + two most significant bits will be set to 1, if <c>Top</c> is 0, the + most significant bit will be 1, and if <c>Top</c> is -1 then no + constraints are applied and thus the generated number may be less than + N bits long.</p> + <p>If <c>Bottom</c> is 1, then the generated number is + constrained to be odd.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>mod_exp(N, P, M) -> Result</name> <fsummary>Perform N ^ P mod M</fsummary> <type> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 5e9bda3920..ab1ffa9e5c 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 2.0.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 2.0.2.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index d6e2e033c0..cc7b3acc9c 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ -export([rsa_private_encrypt/3, rsa_public_decrypt/3]). -export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). -export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). +-export([strong_rand_bytes/1, strong_rand_mpint/3]). -export([mod_exp/3, mpint/1, erlint/1]). %% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]). -export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). @@ -68,6 +69,8 @@ des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, + strong_rand_bytes, + strong_rand_mpint, rand_uniform, mod_exp, dss_verify,dss_sign, @@ -361,12 +364,32 @@ aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% RAND - pseudo random numbers using RN_ functions in crypto lib %% -spec rand_bytes(non_neg_integer()) -> binary(). +-spec strong_rand_bytes(non_neg_integer()) -> binary(). -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). +-spec strong_rand_mpint(Bits::non_neg_integer(), + Top::-1..1, + Bottom::0..1) -> binary(). rand_bytes(_Bytes) -> ?nif_stub. + +strong_rand_bytes(Bytes) -> + case strong_rand_bytes_nif(Bytes) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_bytes_nif(_Bytes) -> ?nif_stub. + rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. +strong_rand_mpint(Bits, Top, Bottom) -> + case strong_rand_mpint_nif(Bits,Top,Bottom) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. + + rand_uniform(From,To) when is_binary(From), is_binary(To) -> case rand_uniform_nif(From,To) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index fe8f8e69a0..854a8b4485 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -46,6 +46,7 @@ aes_ctr/1, mod_exp_test/1, rand_uniform_test/1, + strong_rand_test/1, rsa_verify_test/1, dsa_verify_test/1, rsa_sign_test/1, @@ -68,7 +69,8 @@ all() -> md5_mac_io, sha, sha_update, %% sha256, sha256_update, sha512,sha512_update, des_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test, + aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, + rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, @@ -710,6 +712,33 @@ rand_uniform_aux_test(N) -> %% %% +strong_rand_test(doc) -> + "strong_rand_mpint and strong_random_bytes testing"; +strong_rand_test(suite) -> + []; +strong_rand_test(Config) when is_list(Config) -> + strong_rand_aux_test(180), + ?line 10 = byte_size(crypto:strong_rand_bytes(10)). + +strong_rand_aux_test(0) -> + ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), + ok; +strong_rand_aux_test(1) -> + ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), + ?line strong_rand_aux_test(0); +strong_rand_aux_test(N) -> + ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), + ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), + ?line strong_rand_aux_test(N-1). + +sru_length(Mpint) -> + I = crypto:erlint(Mpint), + length(erlang:integer_to_list(I, 2)). + +%% +%% %% %% rsa_verify_test(doc) -> @@ -1097,7 +1126,7 @@ worker_loop(0, _) -> ok; worker_loop(N, Config) -> Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, - aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, + aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test }, F = element(random:uniform(size(Funcs)),Funcs), diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index e2d6fd0b37..740c68d8fa 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 2.0.2.1 +CRYPTO_VSN = 2.0.2.2 diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index 1d7a1a6222..d519ac960b 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -37,7 +37,7 @@ The parameters are: The analysis starts from .beam bytecode files. The files must be compiled with +debug_info. - Source code: - The analysis starts from .erl files. + The analysis starts from .erl files. Controlling the discrepancies reported by the Dialyzer ====================================================== @@ -131,7 +131,7 @@ Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] [--no_native] [--fullpath] -Options: +Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the specified files or directories containing .erl or .beam files, @@ -169,7 +169,7 @@ Options: --output_plt file Store the plt at the specified file after building it. --plt plt - Use the specified plt as the initial plt (if the plt was built + Use the specified plt as the initial plt (if the plt was built during setup the files will be checked for consistency). --plts plt* Merge the specified plts to create the initial plt -- requires @@ -204,8 +204,8 @@ Options: --add_to_plt The plt is extended to also include the files specified with -c and -r. Use --plt to specify which plt to start from, and --output_plt to - specify where to put the plt. Note that the analysis might include - files from the plt if they depend on the new files. + specify where to put the plt. Note that the analysis might include + files from the plt if they depend on the new files. This option only works with beam files. --remove_from_plt The information from the files specified with -c and -r is removed @@ -269,13 +269,13 @@ Warning options: Include warnings about behaviour callbacks which drift from the published recommended interfaces. -Wunderspecs *** - Warn about underspecified functions + Warn about underspecified functions (those whose -spec is strictly more allowing than the success typing). The following options are also available but their use is not recommended: (they are mostly for Dialyzer developers and internal debugging) -Woverspecs *** - Warn about overspecified functions + Warn about overspecified functions (those whose -spec is strictly less allowing than the success typing). -Wspecdiffs *** Warn when the -spec is different than the success typing. @@ -306,8 +306,8 @@ dialyzer:run(OptList) -> Warnings Warnings :: [{tag(), id(), msg()}] tag() :: 'warn_return_no_exit' | 'warn_return_only_exit' | 'warn_not_called' | 'warn_non_proper_list' | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' | 'warn_contract_subtype' | 'warn_contract_supertype' id() :: {File :: string(), Line :: integer()} msg() :: Undefined @@ -319,24 +319,31 @@ Option :: {files, [Filename :: string()]} | {from, src_code | byte_code} %% Defaults to byte_code | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName :: string()]} + | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} | {output_plt, FileName :: string()} | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} | {warnings, [WarnOpts]} + | {get_warnings, bool()} WarnOpts :: no_return | no_unused | no_improper_lists | no_fun_app | no_match + | no_opaque | no_fail_call - | unmatched_returns | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs dialyzer:format_warning({tag(), id(), msg()}) -> string() - + Returns a string representation of the warnings as returned by dialyzer:run/1. dialyzer:plt_info(string()) -> {'ok', [{atom(), any()}]} | {'error', atom()} @@ -392,7 +399,7 @@ files that depend on these files. Note that this consistency check will be performed automatically the next time you run Dialyzer with this plt. The --check_plt option is merely for doing so without doing any other analysis. - + ----------------------------------------------- -- -- Feedback & bug reports diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index b6547b11e1..4080dfdf77 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -241,7 +241,7 @@ <item>Include warnings about behaviour callbacks which drift from the published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> - <item>Warn about underspecified functions + <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> </taglist> <p>The following options are also available but their use is not @@ -249,7 +249,7 @@ debugging)</p> <taglist> <tag><c><![CDATA[-Woverspecs]]></c>***</tag> - <item>Warn about overspecified functions + <item>Warn about overspecified functions (the -spec is strictly less allowing than the success typing).</item> <tag><c><![CDATA[-Wspecdiffs]]></c>***</tag> <item>Warn when the -spec is different than the success typing.</item> @@ -278,34 +278,34 @@ <desc> <p>Dialyzer GUI version.</p> <code type="none"><![CDATA[ -OptList : [Option] -Option : {files, [Filename : string()]} - | {files_rec, [DirName : string()]} - | {defines, [{Macro: atom(), Value : term()}]} - | {from, src_code | byte_code} %% Defaults to byte_code - | {init_plt, FileName : string()} %% If changed from default - | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName : string()]} - | {output_file, FileName : string()} - | {output_plt, FileName :: string()} - | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} - | {warnings, [WarnOpts]} - | {get_warnings, bool()} +OptList :: [Option] +Option :: {files, [Filename :: string()]} + | {files_rec, [DirName :: string()]} + | {defines, [{Macro: atom(), Value : term()}]} + | {from, src_code | byte_code} %% Defaults to byte_code + | {init_plt, FileName :: string()} %% If changed from default + | {plts, [FileName :: string()]} %% If changed from default + | {include_dirs, [DirName :: string()]} + | {output_file, FileName :: string()} + | {output_plt, FileName :: string()} + | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} + | {warnings, [WarnOpts]} + | {get_warnings, bool()} -WarnOpts : no_return - | no_unused - | no_improper_lists - | no_fun_app - | no_match - | no_opaque - | no_fail_call - | error_handling - | race_conditions - | behaviours - | unmatched_returns - | overspecs - | underspecs - | specdiffs +WarnOpts :: no_return + | no_unused + | no_improper_lists + | no_fun_app + | no_match + | no_opaque + | no_fail_call + | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs ]]></code> </desc> </func> @@ -320,12 +320,12 @@ WarnOpts : no_return <p>Dialyzer command line version.</p> <code type="none"><![CDATA[ Warnings :: [{Tag, Id, Msg}] -Tag : 'warn_return_no_exit' | 'warn_return_only_exit' - | 'warn_not_called' | 'warn_non_proper_list' - | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' - | 'warn_contract_subtype' | 'warn_contract_supertype' +Tag :: 'warn_return_no_exit' | 'warn_return_only_exit' + | 'warn_not_called' | 'warn_non_proper_list' + | 'warn_fun_app' | 'warn_matching' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_contract_subtype' | 'warn_contract_supertype' Id = {File :: string(), Line :: integer()} Msg = msg() -- Undefined ]]></code> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 24d6013692..b8da57d3f9 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -155,19 +155,24 @@ postprocess_dataflow_warns(RawWarnings, State, WarnAcc) -> postprocess_dataflow_warns([], _State, WAcc, Acc) -> {WAcc, lists:reverse(Acc)}; -postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {File, CallL}, Msg}|Rest], +postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], #st{codeserver = Codeserver} = State, WAcc, Acc) -> {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, - {ok, {{File, _ContrL} = FileLine, _C}} = + {ok, {{ContrF, _ContrL} = FileLine, _C}} = dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver), - NewMsg = - {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, - W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, - Filter = - fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; - (_) -> true - end, - postprocess_dataflow_warns(Rest, State, lists:filter(Filter, WAcc), [W|Acc]); + case CallF =:= ContrF of + true -> + NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, + W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, + Filter = + fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; + (_) -> true + end, + FilterWAcc = lists:filter(Filter, WAcc), + postprocess_dataflow_warns(Rest, State, FilterWAcc, [W|Acc]); + false -> + postprocess_dataflow_warns(Rest, State, WAcc, Acc) + end; postprocess_dataflow_warns([W|Rest], State, Wacc, Acc) -> postprocess_dataflow_warns(Rest, State, Wacc, [W|Acc]). diff --git a/lib/dialyzer/test/small_tests_SUITE.erl b/lib/dialyzer/test/small_tests_SUITE.erl index 21a2c76160..dbcc044eea 100644 --- a/lib/dialyzer/test/small_tests_SUITE.erl +++ b/lib/dialyzer/test/small_tests_SUITE.erl @@ -18,18 +18,18 @@ contract5/1, disj_norm_form/1, eqeq/1, ets_select/1, exhaust_case/1, failing_guard1/1, flatten/1, fun_app/1, fun_ref_match/1, fun_ref_record/1, gencall/1, gs_make/1, - inf_loop2/1, letrec1/1, list_match/1, lzip/1, make_tuple/1, - minus_minus/1, mod_info/1, my_filter/1, my_sofs/1, no_match/1, - no_unused_fun/1, no_unused_fun2/1, non_existing/1, - not_guard_crash/1, or_bug/1, orelsebug/1, orelsebug2/1, - overloaded1/1, port_info_test/1, process_info_test/1, pubsub/1, - receive1/1, record_construct/1, record_pat/1, - record_send_test/1, record_test/1, recursive_types1/1, - recursive_types2/1, recursive_types3/1, recursive_types4/1, - recursive_types5/1, recursive_types6/1, recursive_types7/1, - refine_bug1/1, toth/1, trec/1, try1/1, tuple1/1, - unsafe_beamcode_bug/1, unused_cases/1, unused_clauses/1, - zero_tuple/1]). + inf_loop2/1, invalid_specs/1, letrec1/1, list_match/1, lzip/1, + make_tuple/1, minus_minus/1, mod_info/1, my_filter/1, + my_sofs/1, no_match/1, no_unused_fun/1, no_unused_fun2/1, + non_existing/1, not_guard_crash/1, or_bug/1, orelsebug/1, + orelsebug2/1, overloaded1/1, port_info_test/1, + process_info_test/1, pubsub/1, receive1/1, record_construct/1, + record_pat/1, record_send_test/1, record_test/1, + recursive_types1/1, recursive_types2/1, recursive_types3/1, + recursive_types4/1, recursive_types5/1, recursive_types6/1, + recursive_types7/1, refine_bug1/1, toth/1, trec/1, try1/1, + tuple1/1, unsafe_beamcode_bug/1, unused_cases/1, + unused_clauses/1, zero_tuple/1]). suite() -> [{timetrap, {minutes, 1}}]. @@ -51,10 +51,10 @@ all() -> atom_guard,atom_widen,bs_fail_constr,bs_utf8,cerl_hipeify,comm_layer, compare1,confusing_warning,contract2,contract3,contract5,disj_norm_form, eqeq,ets_select,exhaust_case,failing_guard1,flatten,fun_app,fun_ref_match, - fun_ref_record,gencall,gs_make,inf_loop2,letrec1,list_match,lzip, - make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,no_unused_fun, - no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,orelsebug2, - overloaded1,port_info_test,process_info_test,pubsub,receive1, + fun_ref_record,gencall,gs_make,inf_loop2,invalid_specs,letrec1,list_match, + lzip,make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match, + no_unused_fun,no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug, + orelsebug2,overloaded1,port_info_test,process_info_test,pubsub,receive1, record_construct,record_pat,record_send_test,record_test,recursive_types1, recursive_types2,recursive_types3,recursive_types4,recursive_types5, recursive_types6,recursive_types7,refine_bug1,toth,trec,try1,tuple1, @@ -235,6 +235,12 @@ inf_loop2(Config) -> Error -> ct:fail(Error) end. +invalid_specs(Config) -> + case dialyze(Config, invalid_specs) of + 'same' -> 'same'; + Error -> ct:fail(Error) + end. + letrec1(Config) -> case dialyze(Config, letrec1) of 'same' -> 'same'; diff --git a/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs new file mode 100644 index 0000000000..c95c0ff1f8 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs @@ -0,0 +1,3 @@ + +invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]} +invalid_spec2.erl:5: Function foo/0 has no local return diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl new file mode 100644 index 0000000000..06ab2f9a22 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl @@ -0,0 +1,28 @@ +-module(invalid_spec1). + +-export([get_plan_dirty/1]). + +-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}. + +get_plan_dirty(ClassL) -> + get_plan_dirty(ClassL, [], []). + +get_plan_dirty([], Res, FoundClassList) -> + {Res,FoundClassList}; +get_plan_dirty([Class|ClassL], Res, FoundClassList) -> + ClassPlan = list_to_atom(Class ++ "_plan"), + case catch mnesia:dirty_all_keys(ClassPlan) of + {'EXIT',_} -> + get_plan_dirty(ClassL, Res, FoundClassList); + [] -> + get_plan_dirty(ClassL, Res, FoundClassList); + KeyL -> + ClassAtom = list_to_atom(Class), + Res2 = + lists:foldl(fun(Key, Acc) -> + [{ClassAtom,Key}|Acc] + end, + Res, + KeyL), + get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList]) + end. diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl new file mode 100644 index 0000000000..e49f73d014 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl @@ -0,0 +1,11 @@ +-module(invalid_spec2). + +-export([foo/0]). + +foo() -> + case + invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo)) + of + {[],[]} -> foo; + { _, _} -> bar + end. diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c index d9560eebc8..146a106e7c 100644 --- a/lib/erl_interface/src/legacy/erl_timeout.c +++ b/lib/erl_interface/src/legacy/erl_timeout.c @@ -43,6 +43,7 @@ # endif #endif +#include "erl_interface.h" #include "erl_timeout.h" typedef struct jmp_s { diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index 4751f1094a..45d2387e7b 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -33,7 +33,7 @@ -export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1, command/2, command/3, trie_new/0, trie_store/2, trie_match/2, split_node/1, consult_file/1, list_dir/1, format_exit_term/1, - format_exception/1, format_error/1]). + format_exception/1, format_exception/2, format_error/1]). %% Type definitions for describing exceptions @@ -55,21 +55,23 @@ %% --------------------------------------------------------------------- %% Formatting of error descriptors +format_exception(Exception) -> + format_exception(Exception, 20). -format_exception({Class,Term,Trace}) +format_exception({Class,Term,Trace}, Depth) when is_atom(Class), is_list(Trace) -> case is_stacktrace(Trace) of true -> io_lib:format("~w:~P\n~s", - [Class, Term, 20, format_stacktrace(Trace)]); + [Class, Term, Depth, format_stacktrace(Trace)]); false -> - format_term(Term) + format_term(Term, Depth) end; -format_exception(Term) -> - format_term(Term). +format_exception(Term, Depth) -> + format_term(Term, Depth). -format_term(Term) -> - io_lib:format("~P\n", [Term, 15]). +format_term(Term, Depth) -> + io_lib:format("~P\n", [Term, Depth]). format_exit_term(Term) -> {Reason, Trace} = analyze_exit_term(Term), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index eb994a990a..f289cd724a 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -323,7 +323,7 @@ write_testcase( format_testcase_result(ok) -> [<<>>]; format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) -> [?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({failed, Term}) -> [?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE, @@ -331,7 +331,7 @@ format_testcase_result({failed, Term}) -> ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) -> [?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE]; format_testcase_result({aborted, Term}) -> [?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE, diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index de0f23bf24..93563c6011 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -539,27 +539,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) when ?ip(A,B,C,D), ?port(Port) -> gen_udp:send(I, IP, Port, Buffer). -udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout) +udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout); -udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout) + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout); +udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout). - -do_udp_recv(Recv, IP, Port, Timeout) -> - do_udp_recv(Recv, IP, Port, Timeout, - if Timeout =/= 0 -> erlang:now(); true -> undefined end). - -do_udp_recv(Recv, IP, Port, Timeout, Then) -> - case Recv(Timeout) of - {ok,{IP,Port,Answer}} -> - {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))}; - {ok,_} when Timeout =:= 0 -> - {error,timeout}; - {ok,_} -> - Now = erlang:now(), - T = erlang:max(0, Timeout - now_ms(Now, Then)), - do_udp_recv(Recv, IP, Port, T, Now); + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout). + +do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> + timeout; +do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> + case gen_udp:recv(I, 0, T) of + {ok,Reply} -> + case Decode(Reply) of + false when T =:= 0 -> + %% This is a compromize between the hard way i.e + %% in the clause below if NewT becomes 0 bailout + %% immediately and risk that the right reply lies + %% ahead after some bad id replies, and the + %% forgiving way i.e go on with Timeout 0 until + %% the right reply comes or no reply (timeout) + %% which opens for a DOS attack by a malicious + %% DNS server flooding with bad id replies causing + %% an infinite loop here. + %% + %% Timeout is used as a sanity limit counter + %% just to put an end to the loop. + NewTimeout = erlang:max(0, Timeout - 50), + do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); + false -> + Now = erlang:now(), + NewT = erlang:max(0, Timeout - now_ms(Now, Start)), + do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); + Result -> + Result + end; Error -> Error end. @@ -580,6 +594,17 @@ udp_close(#sock{inet=I,inet6=I6}) -> %% end %% end %% +%% But that man page also says dig always use num_servers = 1. +%% +%% Our man page says: timeout/retry, then double for next retry, i.e +%% for i = 0 to retry - 1 +%% foreach nameserver +%% send query +%% wait((time * (2**i)) / retry) +%% end +%% end +%% +%% And that is what the code seems to do, now fixed, hopefully... do_query(_Q, [], _Timer) -> {error,nxdomain}; @@ -589,19 +614,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) -> query_retries(_Q, _NSs, _Timer, Retry, Retry, S) -> udp_close(S), {error,timeout}; +query_retries(_Q, [], _Timer, _Retry, _I, S) -> + udp_close(S), + {error,timeout}; query_retries(Q, NSs, Timer, Retry, I, S0) -> - Num = length(NSs), - if Num =:= 0 -> - udp_close(S0), - {error,timeout}; - true -> - case query_nss(Q, NSs, Timer, Retry, I, S0, []) of - {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers - query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); - {S,Result} -> - udp_close(S), - Result - end + case query_nss(Q, NSs, Timer, Retry, I, S0, []) of + {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers + query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); + {S,Result} -> + udp_close(S), + Result end. query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) -> @@ -611,13 +633,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs). -query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, - edns={Id,Buffer}}=Q, - [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, PSz), +query_nss_edns( + #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q, + [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> + {S,Res}=Reply = + query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{nxdomain,_}} -> Reply; {error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail; @@ -629,17 +651,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) end. -query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs], - Timer, Retry, I, S0, ErrNSs) -> +query_nss_dns( + #q{dns=Qdns}=Q0, + [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) -> #q{options=Options,dns={Id,Buffer}}=Q = if is_function(Qdns, 0) -> Q0#q{dns=Qdns()}; true -> Q0 end, - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, ?PACKETSZ), + {S,Res}=Reply = + query_ns( + S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply; {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused -> @@ -653,48 +677,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, PSz) -> case UseVC orelse iolist_size(Buffer) > PSz of true -> - {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)}; + TcpTimeout = inet:timeout(Tm*5, Timer), + {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)}; false -> case udp_open(S0, IP) of {ok,S} -> - {S,case query_udp(S, Id, Buffer, IP, Port, Timer, - Retry, I, Tm, Verbose) of - {ok,#dns_rec{header=H}} when H#dns_header.tc -> - query_tcp(Tm, Id, Buffer, - IP, Port, Timer, Verbose); - Reply -> Reply - end}; + Timeout = + inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), + {S, + case query_udp( + S, Id, Buffer, IP, Port, Timeout, Verbose) of + {ok,#dns_rec{header=H}} when H#dns_header.tc -> + TcpTimeout = inet:timeout(Tm*5, Timer), + query_tcp( + TcpTimeout, Id, Buffer, IP, Port, Verbose); + Reply -> Reply + end}; Error -> {S0,Error} end end. -query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) -> - Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), +query_udp(_S, _Id, _Buffer, _IP, _Port, 0, Verbose) -> + timeout; +query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) -> ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n", - [IP, Port, Timeout]), - udp_connect(S, IP, Port), - udp_send(S, IP, Port, Buffer), - query_udp_recv(S, IP, Port, Id, Timeout, Verbose). - -query_udp_recv(S, IP, Port, Id, Timeout, Verbose) -> - case udp_recv(S, IP, Port, Timeout) of - {ok,Answer,T} -> - case decode_answer(Answer, Id, Verbose) of - {error, badid} -> - query_udp_recv(S, IP, Port, Id, T, Verbose); - Reply -> Reply + [IP,Port,Timeout]), + case + case udp_connect(S, IP, Port) of + ok -> + udp_send(S, IP, Port, Buffer); + E1 -> + E1 end of + ok -> + Decode = + fun ({RecIP,RecPort,Answer}) + when RecIP =:= IP, RecPort =:= Port -> + case decode_answer(Answer, Id, Verbose) of + {error,badid} -> + false; + Reply -> + Reply + end; + ({_,_,_}) -> + false + end, + case udp_recv(S, IP, Port, Timeout, Decode) of + {ok,_}=Result -> + Result; + E2 -> + ?verbose(Verbose, "UDP server error: ~p\n", [E2]), + E2 end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "UDP server timeout\n", []), - timeout; - Error -> - ?verbose(Verbose, "UDP server error: ~p\n", [Error]), - Error + E3 -> + ?verbose(Verbose, "UDP send failed: ~p\n", [E3]), + {error,econnrefused} end. -query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> - Timeout = inet:timeout(Tm*5, Timer), +query_tcp(0, _Id, _Buffer, _IP, _Port, Verbose) -> + timeout; +query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) -> ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n", [IP, Port, Timeout]), Family = case IP of @@ -716,19 +758,10 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> end; Error -> gen_tcp:close(S), - case Error of - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server recv timeout\n", []), - timeout; - _ -> - ?verbose(Verbose, "TCP server recv error: ~p\n", - [Error]), - Error - end + ?verbose(Verbose, "TCP server recv error: ~p\n", + [Error]), + Error end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server connect timeout\n", []), - timeout; Error -> ?verbose(Verbose, "TCP server error: ~p\n", [Error]), Error diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 49a02359b0..5228d4fe01 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1249,7 +1249,7 @@ protocol_childspecs([H|T]) -> epmd_module() -> case init:get_argument(epmd_module) of {ok,[[Module]]} -> - Module; + list_to_atom(Module); _ -> erl_epmd end. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 8078c7d021..2f73394c4e 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -2055,6 +2055,10 @@ try_read_file_list(Fd) -> ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n", ?line Title = io:get_line(Fd, ''), + %% Seek past the end of the file. + + ?line {ok, _} = ?FILE_MODULE:position(Fd, 25000), + %% Done. ?line ?FILE_MODULE:close(Fd), diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 043c753cf8..233e438dc9 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, - reboot/1, set_cmd/1, clear_cmd/1, + reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1, dont_drop/1, kill_pid/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -58,7 +58,7 @@ end_per_testcase(_Func, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, restart, reboot, set_cmd, clear_cmd, kill_pid]. + [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid]. groups() -> []. @@ -246,6 +246,15 @@ clear_cmd(Config) when is_list(Config) -> end, ok. +get_cmd(suite) -> []; +get_cmd(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + Cmd = "test", + ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]), + ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + stop_node(Node), + ok. + dont_drop(suite) -> %%% Removed as it may crash epmd/distribution in colourful %%% ways. While we ARE finding out WHY, it would diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 5fc8df475d..6064a9b2d9 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -27,7 +27,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2]). --export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]). +-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1, + last_ms_answer/1]). -export([ gethostbyaddr/0, gethostbyaddr/1, gethostbyaddr_v6/0, gethostbyaddr_v6/1, @@ -45,6 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, resolve, edns0, txt_record, files_monitor, + last_ms_answer, gethostbyaddr, gethostbyaddr_v6, gethostbyname, gethostbyname_v6, getaddr, getaddr_v6, ipv4_to_ipv6, host_and_addr]. @@ -64,16 +66,15 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -zone_dir(basic) -> - otptest; -zone_dir(resolve) -> - otptest; -zone_dir(edns0) -> - otptest; -zone_dir(files_monitor) -> - otptest; -zone_dir(_) -> - undefined. +zone_dir(TC) -> + case TC of + basic -> otptest; + resolve -> otptest; + edns0 -> otptest; + files_monitor -> otptest; + last_ms_answer -> otptest; + _ -> undefined + end. init_per_testcase(Func, Config) -> PrivDir = ?config(priv_dir, Config), @@ -184,6 +185,88 @@ ns_printlog(Fname) -> ok end. +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Behaviour modifying nameserver proxy + +proxy_start(TC, {NS,P}) -> + Tag = make_ref(), + Parent = self(), + Pid = + spawn_link( + fun () -> + try proxy_start(TC, NS, P, Parent, Tag) + catch C:X -> + io:format( + "~w: ~w:~p ~p~n", + [self(),C,X,erlang:get_stacktrace()]) + end + end), + receive {started,Tag,Port} -> + ProxyNS = {{127,0,0,1},Port}, + {proxy,Pid,Tag,ProxyNS} + end. + +proxy_start(TC, NS, P, Parent, Tag) -> + {ok,Outbound} = gen_udp:open(0, [binary]), + ok = gen_udp:connect(Outbound, NS, P), + {ok,Inbound} = gen_udp:open(0, [binary]), + {ok,Port} = inet:port(Inbound), + Parent ! {started,Tag,Port}, + proxy(TC, Outbound, NS, P, Inbound). + + +%% To provoke the last_ms_answer bug (OTP-9221) the proxy +%% * Relays the query to the right nameserver +%% * Intercepts the reply but holds it until the timer that +%% was started when receiving the query fires. +%% * Repeats the reply with incorrect query ID a number of +%% times with a short interval. +%% * Sends the correct reply, to give a correct test result +%% after bug correction. +%% +%% The repetition of an incorrect answer with tight interval will keep +%% inet_res in an inner loop in the code that decrements the remaining +%% time until it hits 0 which triggers a crash, if the outer timeout +%% parameter to inet_res:resolve is so short that it runs out during +%% these repetitions. +proxy(last_ms_answer, Outbound, NS, P, Inbound) -> + receive + {udp,Inbound,SrcIP,SrcPort,Data} -> + Time = + inet_db:res_option(timeout) div inet_db:res_option(retry), + Tag = erlang:make_ref(), + erlang:send_after(Time - 10, self(), {time,Tag}), + ok = gen_udp:send(Outbound, NS, P, Data), + receive + {udp,Outbound,NS,P,Reply} -> + {ok,Msg} = inet_dns:decode(Reply), + Hdr = inet_dns:msg(Msg, header), + Id = inet_dns:header(Hdr, id), + BadHdr = + inet_dns:make_header(Hdr, id, (Id+1) band 16#ffff), + BadMsg = inet_dns:make_msg(Msg, header, BadHdr), + BadReply = inet_dns:encode(BadMsg), + receive + {time,Tag} -> + proxy__last_ms_answer( + Inbound, SrcIP, SrcPort, BadReply, Reply, 30) + end + end + end. + +proxy__last_ms_answer(Socket, IP, Port, _, Reply, 0) -> + ok = gen_udp:send(Socket, IP, Port, Reply); +proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N) -> + ok = gen_udp:send(Socket, IP, Port, BadReply), + receive after 1 -> ok end, + proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N-1). + +proxy_wait({proxy,Pid,_,_}) -> + Mref = erlang:monitor(process, Pid), + receive {'DOWN',Mref,_,_,_} -> ok end. + +proxy_ns({proxy,_,_,ProxyNS}) -> ProxyNS. + %% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -204,7 +287,7 @@ basic(Config) when is_list(Config) -> {ok,Msg1} = inet_dns:decode(Bin1), %% %% resolve - {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]), + {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]), io:format("~p~n", [Msg2]), [RR2] = inet_dns:msg(Msg2, anlist), IP = inet_dns:rr(RR2, data), @@ -474,6 +557,26 @@ do_files_monitor(Config) -> ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +last_ms_answer(doc) -> + ["Answer just when timeout is triggered (OTP-9221)"]; +last_ms_answer(Config) when is_list(Config) -> + NS = ns(Config), + Name = "ns.otptest", + %%IP = {127,0,0,254}, + Time = inet_db:res_option(timeout) div inet_db:res_option(retry), + PSpec = proxy_start(last_ms_answer, NS), + ProxyNS = proxy_ns(PSpec), + %% + %% resolve; whith short timeout to trigger Timeout =:= 0 in inet_res + {error,timeout} = + inet_res:resolve( + Name, in, a, [{nameservers,[ProxyNS]},verbose], Time + 10), + %% + proxy_wait(PSpec), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compatibility tests. Call the inet_SUITE tests, but with %% lookup = [file,dns] instead of [native] diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index ccf70b8373..19574a1434 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,35 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.4.17</title> + <section><title>Mnesia 4.4.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Call chmod without the "-f" flag</p> + <p> + "-f" is a non-standard chmod option which at least SGI + IRIX and HP UX do not support. As the only effect of the + "-f" flag is to suppress warning messages, it can be + safely omitted. (Thanks to Holger Wei�)</p> + <p> + Own Id: OTP-9170</p> + </item> + <item> + <p> + Mnesia sometimes failed to update meta-information in + large systems, which could cause table content to be + inconsistent between nodes.</p> + <p> + Own Id: OTP-9186 Aux Id: seq11728 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.4.17</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src index 0eff761b61..7bad6c4ea6 100644 --- a/lib/mnesia/src/mnesia.appup.src +++ b/lib/mnesia/src/mnesia.appup.src @@ -1,25 +1,33 @@ %% -*- erlang -*- {"%VSN%", [ - {"4.4.16",[ - {update, mnesia_frag, soft, soft_purge, soft_purge, []}, - {update, mnesia_schema, soft, soft_purge, soft_purge, []} + {"4.4.17",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []} ]}, - {"4.4.15",[ - {update, mnesia_frag, soft, soft_purge, soft_purge, []}, - {update, mnesia, soft, soft_purge, soft_purge, []}, - {update, mnesia_dumper, soft, soft_purge, soft_purge, []} - ]} - ], - [ {"4.4.16",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, {update, mnesia_frag, soft, soft_purge, soft_purge, []}, {update, mnesia_schema, soft, soft_purge, soft_purge, []} ]}, {"4.4.15",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, {update, mnesia_frag, soft, soft_purge, soft_purge, []}, {update, mnesia, soft, soft_purge, soft_purge, []}, {update, mnesia_dumper, soft, soft_purge, soft_purge, []} ]} - ] + ], + {"4.4.17",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []} + ]}, + {"4.4.16",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, + {update, mnesia_frag, soft, soft_purge, soft_purge, []}, + {update, mnesia_schema, soft, soft_purge, soft_purge, []} + ]}, + {"4.4.15",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, + {update, mnesia_frag, soft, soft_purge, soft_purge, []}, + {update, mnesia, soft, soft_purge, soft_purge, []}, + {update, mnesia_dumper, soft, soft_purge, soft_purge, []} + ]} }. diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 021be8af2a..0254769758 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -457,7 +457,7 @@ connect_nodes2(Father, Ns, UserFun) -> New1 = mnesia_lib:intersect(Ns, Connected), New = New1 -- Current, process_flag(trap_exit, true), - Res = try_merge_schema(New, UserFun), + Res = try_merge_schema(New, [], UserFun), Msg = {schema_is_merged, [], late_merge, []}, multicall([node()|Ns], Msg), After = val({current, db_nodes}), @@ -471,7 +471,7 @@ connect_nodes2(Father, Ns, UserFun) -> merge_schema() -> AllNodes = mnesia_lib:all_nodes(), - case try_merge_schema(AllNodes, fun default_merge/1) of + case try_merge_schema(AllNodes, [node()], fun default_merge/1) of ok -> schema_is_merged(); {aborted, {throw, Str}} when is_list(Str) -> @@ -483,11 +483,17 @@ merge_schema() -> default_merge(F) -> F([]). -try_merge_schema(Nodes, UserFun) -> +try_merge_schema(Nodes, Told0, UserFun) -> case mnesia_schema:merge_schema(UserFun) of {atomic, not_merged} -> %% No more nodes that we need to merge the schema with - ok; + %% Ensure we have told everybody that we are running + case val({current,db_nodes}) -- mnesia_lib:uniq(Told0) of + [] -> ok; + Tell -> + im_running(Tell, [node()]), + ok + end; {atomic, {merged, OldFriends, NewFriends}} -> %% Check if new nodes has been added to the schema Diff = mnesia_lib:all_nodes() -- [node() | Nodes], @@ -496,12 +502,18 @@ try_merge_schema(Nodes, UserFun) -> %% Tell everybody to adopt orphan tables im_running(OldFriends, NewFriends), im_running(NewFriends, OldFriends), - - try_merge_schema(Nodes, UserFun); + Told = case lists:member(node(), NewFriends) of + true -> Told0 ++ OldFriends; + false -> Told0 ++ NewFriends + end, + try_merge_schema(Nodes, Told, UserFun); {atomic, {"Cannot get cstructs", Node, Reason}} -> dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]), - timer:sleep(1000), % Avoid a endless loop look alike - try_merge_schema(Nodes, UserFun); + timer:sleep(300), % Avoid a endless loop look alike + try_merge_schema(Nodes, Told0, UserFun); + {aborted, {shutdown, _}} -> %% One of the nodes is going down + timer:sleep(300), % Avoid a endless loop look alike + try_merge_schema(Nodes, Told0, UserFun); Other -> Other end. @@ -915,6 +927,7 @@ handle_cast(unblock_controller, State) -> handle_cast({mnesia_down, Node}, State) -> maybe_log_mnesia_down(Node), mnesia_lib:del({current, db_nodes}, Node), + mnesia_lib:unset({node_up, Node}), mnesia_checkpoint:tm_mnesia_down(Node), Alltabs = val({schema, tables}), reconfigure_tables(Node, Alltabs), @@ -977,11 +990,12 @@ handle_cast(Msg, State) when State#state.schema_is_merged /= true -> %% This must be done after schema_is_merged otherwise adopt_orphan %% might trigger a table load from wrong nodes as a result of that we don't %% know which tables we can load safly first. -handle_cast({im_running, _Node, NewFriends}, State) -> +handle_cast({im_running, Node, NewFriends}, State) -> LocalTabs = mnesia_lib:local_active_tables() -- [schema], RemoveLocalOnly = fun(Tab) -> not val({Tab, local_content}) end, Tabs = lists:filter(RemoveLocalOnly, LocalTabs), - Ns = mnesia_lib:intersect(NewFriends, val({current, db_nodes})), + Nodes = mnesia_lib:union([Node],val({current, db_nodes})), + Ns = mnesia_lib:intersect(NewFriends, Nodes), abcast(Ns, {adopt_orphans, node(), Tabs}), noreply(State); @@ -1042,30 +1056,33 @@ handle_cast({master_nodes_updated, Tab, Masters}, State) -> end; handle_cast({adopt_orphans, Node, Tabs}, State) -> - State2 = node_has_tabs(Tabs, Node, State), - %% Register the other node as up and running - mnesia_recover:log_mnesia_up(Node), - verbose("Logging mnesia_up ~w~n",[Node]), - mnesia_lib:report_system_event({mnesia_up, Node}), - - %% Load orphan tables - LocalTabs = val({schema, local_tables}) -- [schema], - Nodes = val({current, db_nodes}), - {LocalOrphans, RemoteMasters} = - orphan_tables(LocalTabs, Node, Nodes, [], []), - Reason = {adopt_orphan, node()}, - mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason), - - Fun = - fun(N) -> - RemoteOrphans = - [Tab || {Tab, Ns} <- RemoteMasters, - lists:member(N, Ns)], - mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason) - end, - lists:foreach(Fun, Nodes), + case ?catch_val({node_up,Node}) of + true -> ignore; + _ -> + %% Register the other node as up and running + set({node_up, Node}, true), + mnesia_recover:log_mnesia_up(Node), + verbose("Logging mnesia_up ~w~n",[Node]), + mnesia_lib:report_system_event({mnesia_up, Node}), + %% Load orphan tables + LocalTabs = val({schema, local_tables}) -- [schema], + Nodes = val({current, db_nodes}), + {LocalOrphans, RemoteMasters} = + orphan_tables(LocalTabs, Node, Nodes, [], []), + Reason = {adopt_orphan, node()}, + mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason), + + Fun = + fun(N) -> + RemoteOrphans = + [Tab || {Tab, Ns} <- RemoteMasters, + lists:member(N, Ns)], + mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason) + end, + lists:foreach(Fun, Nodes) + end, noreply(State2); handle_cast(Msg, State) -> diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 5247657b68..38e1a94545 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.4.17 +MNESIA_VSN = 4.4.18 diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 3340f7ee72..3ee1df759f 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -103,6 +103,7 @@ init([]) -> Flavor==darwin; Flavor==linux; Flavor==openbsd; + Flavor==netbsd; Flavor==irix64; Flavor==irix -> start_portprogram(); @@ -267,6 +268,9 @@ check_disk_space({unix, freebsd}, Port, Threshold) -> check_disk_space({unix, openbsd}, Port, Threshold) -> Result = my_cmd("/bin/df -k -t ffs", Port), check_disks_solaris(skip_to_eol(Result), Threshold); +check_disk_space({unix, netbsd}, Port, Threshold) -> + Result = my_cmd("/bin/df -k -t ffs", Port), + check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, sunos4}, Port, Threshold) -> Result = my_cmd("df", Port), check_disks_solaris(skip_to_eol(Result), Threshold); diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 822e1f939c..cc4941ee7d 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -176,9 +176,11 @@ init([]) -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; % Linux supports this. {unix, linux} -> true; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, irix64} -> true; {unix, irix} -> true; {unix, sunos} -> true; @@ -610,8 +612,10 @@ code_change(Vsn, PrevState, "1.8") -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; {unix, linux} -> false; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, sunos} -> true; {win32, _OSname} -> false; vxworks -> true @@ -687,6 +691,7 @@ get_os_wordsize({unix, linux}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, darwin}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, netbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, freebsd}) -> get_os_wordsize_with_uname(); +get_os_wordsize({unix, dragonfly}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, openbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize(_) -> unsupported_os. @@ -736,7 +741,7 @@ get_memory_usage({unix,darwin}) -> %% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct %% vmmeter -get_memory_usage({unix,freebsd}) -> +get_memory_usage({unix,OSname}) when OSname == freebsd; OSname == dragonfly -> PageSize = freebsd_sysctl("vm.stats.vm.v_page_size"), PageCount = freebsd_sysctl("vm.stats.vm.v_page_count"), FreeCount = freebsd_sysctl("vm.stats.vm.v_free_count"), @@ -779,6 +784,9 @@ get_ext_memory_usage(OS, {Alloc, Total}) -> {unix, freebsd} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; + {unix, dragonfly} -> + [{total_memory, Total}, {free_memory, Total-Alloc}, + {system_total_memory, Total}]; {unix, darwin} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src index c65ac7bc99..4986801dad 100644 --- a/lib/public_key/src/public_key.appup.src +++ b/lib/public_key/src/public_key.appup.src @@ -1,6 +1,16 @@ %% -*- erlang -*- {"%VSN%", [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {add_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, @@ -25,6 +35,16 @@ } ], [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {delete_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index 660af4e8ab..a325a975e9 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("public_key/include/public_key.hrl"). -%%-include("public_key.hrl"). -define(error(Format,Args), error(Format,Args,?FILE,?LINE)). -define(warning(Format,Args), warning(Format,Args,?FILE,?LINE)). @@ -42,18 +41,65 @@ -define(NIST5, "2.16.840.1.101.3.2.1.48.5"). -define(NIST6, "2.16.840.1.101.3.2.1.48.6"). +-record(verify_state, { + certs_db, + crl_info, + revoke_state}). %% -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> - [signature_verification, validity_periods, - verifying_name_chaining, - verifying_paths_with_self_issued_certificates, - verifying_basic_constraints, key_usage, - name_constraints, private_certificate_extensions]. + [{group, signature_verification}, + {group, validity_periods}, + {group, verifying_name_chaining}, + {group, verifying_paths_with_self_issued_certificates}, + %%{group, basic_certificate_revocation_tests}, + %%{group, delta_crls}, + %%{group, distribution_points}, + {group, verifying_basic_constraints}, + {group, key_usage}, + {group, name_constraints}, + {group, private_certificate_extensions}]. groups() -> - []. + [{signature_verification, [], [valid_rsa_signature, + invalid_rsa_signature, valid_dsa_signature, + invalid_dsa_signature]}, + {validity_periods, [], + [not_before_invalid, not_before_valid, not_after_invalid, not_after_valid]}, + {verifying_name_chaining, [], + [invalid_name_chain, whitespace_name_chain, capitalization_name_chain, + uid_name_chain, attrib_name_chain, string_name_chain]}, + {verifying_paths_with_self_issued_certificates, [], + [basic_valid, basic_invalid, crl_signing_valid, crl_signing_invalid]}, + %% {basic_certificate_revocation_tests, [], + %% [missing_CRL, revoked_CA, revoked_peer, invalid_CRL_signature, + %% invalid_CRL_issuer, invalid_CRL, valid_CRL, + %% unknown_CRL_extension, old_CRL, fresh_CRL, valid_serial, + %% invalid_serial, valid_seperate_keys, invalid_separate_keys]}, + %% {delta_crls, [], [delta_without_crl, valid_delta_crls, invalid_delta_crls]}, + %% {distribution_points, [], [valid_distribution_points, + %% valid_distribution_points_no_issuing_distribution_point, + %% invalid_distribution_points, valid_only_contains, + %% invalid_only_contains, valid_only_some_reasons, + %% invalid_only_some_reasons, valid_indirect_crl, + %% invalid_indirect_crl, valid_crl_issuer, invalid_crl_issuer]}, + {verifying_basic_constraints,[], + [missing_basic_constraints, valid_basic_constraint, invalid_path_constraints, + valid_path_constraints]}, + {key_usage, [], + [invalid_key_usage, valid_key_usage]}, + {name_constraints, [], + [valid_DN_name_constraints, invalid_DN_name_constraints, + valid_rfc822_name_constraints, + invalid_rfc822_name_constraints, valid_DN_and_rfc822_name_constraints, + invalid_DN_and_rfc822_name_constraints, valid_dns_name_constraints, + invalid_dns_name_constraints, valid_uri_name_constraints, + invalid_uri_name_constraints]}, + {private_certificate_extensions, [], + [unknown_critical_extension, unknown_not_critical_extension]} + ]. init_per_group(_GroupName, Config) -> Config. @@ -61,112 +107,706 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_Func, Config) -> + Datadir = proplists:get_value(data_dir, Config), + put(datadir, Datadir), + Config. + +end_per_testcase(_Func, Config) -> + Config. + +init_per_suite(Config) -> + {skip, "PKIX Conformance test certificates expired 14 of April 2011," + " new conformance test suite uses new format so skip until PKCS-12 support is implemented"}. + %% try crypto:start() of + %% ok -> + %% Config + %% catch _:_ -> + %% {skip, "Crypto did not start"} + %% end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%----------------------------------------------------------------------------- +valid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +valid_rsa_signature(suite) -> + []; +valid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.1", "Valid Signatures Test1", ok}]). + +invalid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +invalid_rsa_signature(suite) -> + []; +invalid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, + { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}]). + +valid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +valid_dsa_signature(suite) -> + []; +valid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.4", "Valid DSA Signatures Test4", ok}, + { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}]). + +invalid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +invalid_dsa_signature(suite) -> + []; +invalid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.6", "Invalid DSA Signature Test6",{bad_cert,invalid_signature}}]). +%%----------------------------------------------------------------------------- +not_before_invalid(doc) -> + [""]; +not_before_invalid(suite) -> + []; +not_before_invalid(Config) when is_list(Config) -> + run([{ "4.2.1", "Invalid CA notBefore Date Test1",{bad_cert, cert_expired}}, + { "4.2.2", "Invalid EE notBefore Date Test2",{bad_cert, cert_expired}}]). + +not_before_valid(doc) -> + [""]; +not_before_valid(suite) -> + []; +not_before_valid(Config) when is_list(Config) -> + run([{ "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, + { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}]). + +not_after_invalid(doc) -> + [""]; +not_after_invalid(suite) -> + []; +not_after_invalid(Config) when is_list(Config) -> + run([{ "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, + { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, + { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7",{bad_cert, cert_expired}}]). + +not_after_valid(doc) -> + [""]; +not_after_valid(suite) -> + []; +not_after_valid(Config) when is_list(Config) -> + run([{ "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]). +%%----------------------------------------------------------------------------- +invalid_name_chain(doc) -> + [""]; +invalid_name_chain(suite) -> + []; +invalid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, + { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}]). + +whitespace_name_chain(doc) -> + [""]; +whitespace_name_chain(suite) -> + []; +whitespace_name_chain(Config) when is_list(Config) -> + run([{ "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, + { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}]). + +capitalization_name_chain(doc) -> + [""]; +capitalization_name_chain(suite) -> + []; +capitalization_name_chain(Config) when is_list(Config) -> + run([{ "4.3.5", "Valid Name Chaining Capitalization Test5",ok}]). + +uid_name_chain(doc) -> + [""]; +uid_name_chain(suite) -> + []; +uid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.6", "Valid Name Chaining UIDs Test6",ok}]). + +attrib_name_chain(doc) -> + [""]; +attrib_name_chain(suite) -> + []; +attrib_name_chain(Config) when is_list(Config) -> + run([{ "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, + { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}]). + +string_name_chain(doc) -> + [""]; +string_name_chain(suite) -> + []; +string_name_chain(Config) when is_list(Config) -> + run([{ "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, + { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, + { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]). + +%%----------------------------------------------------------------------------- + +basic_valid(doc) -> + [""]; +basic_valid(suite) -> + []; +basic_valid(Config) when is_list(Config) -> + run([{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, + { "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, + { "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok} + ]). + +basic_invalid(doc) -> + [""]; +basic_invalid(suite) -> + []; +basic_invalid(Config) when is_list(Config) -> + run([{"4.5.2", "Invalid Basic Self-Issued Old With New Test2", + {bad_cert, {revoked, keyCompromise}}}, + {"4.5.5", "Invalid Basic Self-Issued New With Old Test5", + {bad_cert, {revoked, keyCompromise}}} + ]). + +crl_signing_valid(doc) -> + [""]; +crl_signing_valid(suite) -> + []; +crl_signing_valid(Config) when is_list(Config) -> + run([{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}]). + +crl_signing_invalid(doc) -> + [""]; +crl_signing_invalid(suite) -> + []; +crl_signing_invalid(Config) when is_list(Config) -> + run([{ "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", + {bad_cert, {revoked, keyCompromise}}}, + { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", + {bad_cert, invalid_key_usage}} + ]). + +%%----------------------------------------------------------------------------- +missing_CRL(doc) -> + [""]; +missing_CRL(suite) -> + []; +missing_CRL(Config) when is_list(Config) -> + run([{ "4.4.1", "Missing CRL Test1",{bad_cert, + revocation_status_undetermined}}]). + +revoked_CA(doc) -> + [""]; +revoked_CA(suite) -> + []; +revoked_CA(Config) when is_list(Config) -> + run([{ "4.4.2", "Invalid Revoked CA Test2", {bad_cert, + {revoked, keyCompromise}}}]). + +revoked_peer(doc) -> + [""]; +revoked_peer(suite) -> + []; +revoked_peer(Config) when is_list(Config) -> + run([{ "4.4.3", "Invalid Revoked EE Test3", {bad_cert, + {revoked, keyCompromise}}}]). + +invalid_CRL_signature(doc) -> + [""]; +invalid_CRL_signature(suite) -> + []; +invalid_CRL_signature(Config) when is_list(Config) -> + run([{ "4.4.4", "Invalid Bad CRL Signature Test4", + {bad_cert, revocation_status_undetermined}}]). + +invalid_CRL_issuer(doc) -> + [""]; +invalid_CRL_issuer(suite) -> + []; +invalid_CRL_issuer(Config) when is_list(Config) -> + run({ "4.4.5", "Invalid Bad CRL Issuer Name Test5", + {bad_cert, revocation_status_undetermined}}). + +invalid_CRL(doc) -> + [""]; +invalid_CRL(suite) -> + []; +invalid_CRL(Config) when is_list(Config) -> + run([{ "4.4.6", "Invalid Wrong CRL Test6", + {bad_cert, revocation_status_undetermined}}]). + +valid_CRL(doc) -> + [""]; +valid_CRL(suite) -> + []; +valid_CRL(Config) when is_list(Config) -> + run([{ "4.4.7", "Valid Two CRLs Test7", ok}]). + +unknown_CRL_extension(doc) -> + [""]; +unknown_CRL_extension(suite) -> + []; +unknown_CRL_extension(Config) when is_list(Config) -> + run([{ "4.4.8", "Invalid Unknown CRL Entry Extension Test8", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.9", "Invalid Unknown CRL Extension Test9", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.10", "Invalid Unknown CRL Extension Test10", + {bad_cert, revocation_status_undetermined}}]). + +old_CRL(doc) -> + [""]; +old_CRL(suite) -> + []; +old_CRL(Config) when is_list(Config) -> + run([{ "4.4.11", "Invalid Old CRL nextUpdate Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", + {bad_cert, revocation_status_undetermined}}]). + +fresh_CRL(doc) -> + [""]; +fresh_CRL(suite) -> + []; +fresh_CRL(Config) when is_list(Config) -> + run([{ "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}]). + +valid_serial(doc) -> + [""]; +valid_serial(suite) -> + []; +valid_serial(Config) when is_list(Config) -> + run([ + { "4.4.14", "Valid Negative Serial Number Test14",ok}, + { "4.4.16", "Valid Long Serial Number Test16", ok}, + { "4.4.17", "Valid Long Serial Number Test17", ok} + ]). + +invalid_serial(doc) -> + [""]; +invalid_serial(suite) -> + []; +invalid_serial(Config) when is_list(Config) -> + run([{ "4.4.15", "Invalid Negative Serial Number Test15", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.18", "Invalid Long Serial Number Test18", + {bad_cert, {revoked, keyCompromise}}}]). + +valid_seperate_keys(doc) -> + [""]; +valid_seperate_keys(suite) -> + []; +valid_seperate_keys(Config) when is_list(Config) -> + run([{ "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}]). + +invalid_separate_keys(doc) -> + [""]; +invalid_separate_keys(suite) -> + []; +invalid_separate_keys(Config) when is_list(Config) -> + run([{ "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", + {bad_cert, revocation_status_undetermined}} + ]). +%%----------------------------------------------------------------------------- +missing_basic_constraints(doc) -> + [""]; +missing_basic_constraints(suite) -> + []; +missing_basic_constraints(Config) when is_list(Config) -> + run([{ "4.6.1", "Invalid Missing basicConstraints Test1", + {bad_cert, missing_basic_constraint}}, + { "4.6.2", "Invalid cA False Test2", + {bad_cert, missing_basic_constraint}}, + { "4.6.3", "Invalid cA False Test3", + {bad_cert, missing_basic_constraint}}]). + +valid_basic_constraint(doc) -> + [""]; +valid_basic_constraint(suite) -> + []; +valid_basic_constraint(Config) when is_list(Config) -> + run([{"4.6.4", "Valid basicConstraints Not Critical Test4", ok}]). + +invalid_path_constraints(doc) -> + [""]; +invalid_path_constraints(suite) -> + []; +invalid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, + { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, + { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, + { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, + { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, + { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, + { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", + {bad_cert, max_path_length_reached}}]). -signature_verification(doc) -> [""]; -signature_verification(suite) -> []; -signature_verification(Config) when is_list(Config) -> - run(signature_verification()). -validity_periods(doc) -> [""]; -validity_periods(suite) -> []; -validity_periods(Config) when is_list(Config) -> - run(validity_periods()). -verifying_name_chaining(doc) -> [""]; -verifying_name_chaining(suite) -> []; -verifying_name_chaining(Config) when is_list(Config) -> - run(verifying_name_chaining()). -basic_certificate_revocation_tests(doc) -> [""]; -basic_certificate_revocation_tests(suite) -> []; -basic_certificate_revocation_tests(Config) when is_list(Config) -> - run(basic_certificate_revocation_tests()). -verifying_paths_with_self_issued_certificates(doc) -> [""]; -verifying_paths_with_self_issued_certificates(suite) -> []; -verifying_paths_with_self_issued_certificates(Config) when is_list(Config) -> - run(verifying_paths_with_self_issued_certificates()). -verifying_basic_constraints(doc) -> [""]; -verifying_basic_constraints(suite) -> []; -verifying_basic_constraints(Config) when is_list(Config) -> - run(verifying_basic_constraints()). -key_usage(doc) -> [""]; -key_usage(suite) -> []; -key_usage(Config) when is_list(Config) -> - run(key_usage()). +valid_path_constraints(doc) -> + [""]; +valid_path_constraints(suite) -> + []; +valid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.7", "Valid pathLenConstraint Test7", ok}, + { "4.6.8", "Valid pathLenConstraint Test8", ok}, + { "4.6.13", "Valid pathLenConstraint Test13", ok}, + { "4.6.14", "Valid pathLenConstraint Test14", ok}, + { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, + { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]). + +%%----------------------------------------------------------------------------- +invalid_key_usage(doc) -> + [""]; +invalid_key_usage(suite) -> + []; +invalid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", + {bad_cert,invalid_key_usage} }, + { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", + {bad_cert,invalid_key_usage}}, + { "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", + {bad_cert, revocation_status_undetermined}}, + { "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_key_usage(doc) -> + [""]; +valid_key_usage(suite) -> + []; +valid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.3", "Valid keyUsage Not Critical Test3", ok}]). + +%%----------------------------------------------------------------------------- certificate_policies(doc) -> [""]; certificate_policies(suite) -> []; certificate_policies(Config) when is_list(Config) -> run(certificate_policies()). +%%----------------------------------------------------------------------------- require_explicit_policy(doc) -> [""]; require_explicit_policy(suite) -> []; require_explicit_policy(Config) when is_list(Config) -> run(require_explicit_policy()). +%%----------------------------------------------------------------------------- policy_mappings(doc) -> [""]; policy_mappings(suite) -> []; policy_mappings(Config) when is_list(Config) -> run(policy_mappings()). +%%----------------------------------------------------------------------------- inhibit_policy_mapping(doc) -> [""]; inhibit_policy_mapping(suite) -> []; inhibit_policy_mapping(Config) when is_list(Config) -> run(inhibit_policy_mapping()). +%%----------------------------------------------------------------------------- inhibit_any_policy(doc) -> [""]; inhibit_any_policy(suite) -> []; inhibit_any_policy(Config) when is_list(Config) -> run(inhibit_any_policy()). -name_constraints(doc) -> [""]; -name_constraints(suite) -> []; -name_constraints(Config) when is_list(Config) -> - run(name_constraints()). -distribution_points(doc) -> [""]; -distribution_points(suite) -> []; -distribution_points(Config) when is_list(Config) -> - run(distribution_points()). -delta_crls(doc) -> [""]; -delta_crls(suite) -> []; -delta_crls(Config) when is_list(Config) -> - run(delta_crls()). -private_certificate_extensions(doc) -> [""]; -private_certificate_extensions(suite) -> []; -private_certificate_extensions(Config) when is_list(Config) -> - run(private_certificate_extensions()). - -run() -> - Tests = - [signature_verification(), - validity_periods(), - verifying_name_chaining(), - %%basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - %%certificate_policies(), - %%require_explicit_policy(), - %%policy_mappings(), - %%inhibit_policy_mapping(), - %%inhibit_any_policy(), - name_constraints(), - %distribution_points(), - %delta_crls(), - private_certificate_extensions() - ], - run(lists:append(Tests)). +%%----------------------------------------------------------------------------- + +valid_DN_name_constraints(doc) -> + [""]; +valid_DN_name_constraints(suite) -> + []; +valid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.1", "Valid DN nameConstraints Test1", ok}, + { "4.13.4", "Valid DN nameConstraints Test4", ok}, + { "4.13.5", "Valid DN nameConstraints Test5", ok}, + { "4.13.6", "Valid DN nameConstraints Test6", ok}, + { "4.13.11", "Valid DN nameConstraints Test11", ok}, + { "4.13.14", "Valid DN nameConstraints Test14", ok}, + { "4.13.18", "Valid DN nameConstraints Test18", ok}, + { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}]). + +invalid_DN_name_constraints(doc) -> + [""]; +invalid_DN_name_constraints(suite) -> + []; +invalid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, + { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, + { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, + { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, + { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, + { "4.13.10", "Invalid DN nameConstraints Test10",{bad_cert, name_not_permitted}}, + { "4.13.12", "Invalid DN nameConstraints Test12",{bad_cert, name_not_permitted}}, + { "4.13.13", "Invalid DN nameConstraints Test13",{bad_cert, name_not_permitted}}, + { "4.13.15", "Invalid DN nameConstraints Test15",{bad_cert, name_not_permitted}}, + { "4.13.16", "Invalid DN nameConstraints Test16",{bad_cert, name_not_permitted}}, + { "4.13.17", "Invalid DN nameConstraints Test17",{bad_cert, name_not_permitted}}, + { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", + {bad_cert, name_not_permitted}}]). + +valid_rfc822_name_constraints(doc) -> + [""]; +valid_rfc822_name_constraints(suite) -> + []; +valid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, + { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, + { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}]). + + +invalid_rfc822_name_constraints(doc) -> + [""]; +invalid_rfc822_name_constraints(suite) -> + []; +invalid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.22", "Invalid RFC822 nameConstraints Test22", + {bad_cert, name_not_permitted}}, + { "4.13.24", "Invalid RFC822 nameConstraints Test24", + {bad_cert, name_not_permitted}}, + { "4.13.26", "Invalid RFC822 nameConstraints Test26", + {bad_cert, name_not_permitted}}]). + +valid_DN_and_rfc822_name_constraints(doc) -> + [""]; +valid_DN_and_rfc822_name_constraints(suite) -> + []; +valid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}]). + +invalid_DN_and_rfc822_name_constraints(doc) -> + [""]; +invalid_DN_and_rfc822_name_constraints(suite) -> + []; +invalid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", + {bad_cert, name_not_permitted}}, + { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", + {bad_cert, name_not_permitted}}]). + +valid_dns_name_constraints(doc) -> + [""]; +valid_dns_name_constraints(suite) -> + []; +valid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.30", "Valid DNS nameConstraints Test30", ok}, + { "4.13.32", "Valid DNS nameConstraints Test32", ok}]). + +invalid_dns_name_constraints(doc) -> + [""]; +invalid_dns_name_constraints(suite) -> + []; +invalid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted}}, + { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, + { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted}}]). + +valid_uri_name_constraints(doc) -> + [""]; +valid_uri_name_constraints(suite) -> + []; +valid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.34", "Valid URI nameConstraints Test34", ok}, + { "4.13.36", "Valid URI nameConstraints Test36", ok}]). + +invalid_uri_name_constraints(doc) -> + [""]; +invalid_uri_name_constraints(suite) -> + []; +invalid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.35", "Invalid URI nameConstraints Test35",{bad_cert, name_not_permitted}}, + { "4.13.37", "Invalid URI nameConstraints Test37",{bad_cert, name_not_permitted}}]). + +%%----------------------------------------------------------------------------- +delta_without_crl(doc) -> + [""]; +delta_without_crl(suite) -> + []; +delta_without_crl(Config) when is_list(Config) -> + run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1",{bad_cert, + revocation_status_undetermined}}, + {"4.15.10", "Invalid delta-CRL Test10", {bad_cert, + revocation_status_undetermined}}]). + +valid_delta_crls(doc) -> + [""]; +valid_delta_crls(suite) -> + []; +valid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.2", "Valid delta-CRL Test2", ok}, + { "4.15.5", "Valid delta-CRL Test5", ok}, + { "4.15.7", "Valid delta-CRL Test7", ok}, + { "4.15.8", "Valid delta-CRL Test8", ok} + ]). + +invalid_delta_crls(doc) -> + [""]; +invalid_delta_crls(suite) -> + []; +invalid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.3", "Invalid delta-CRL Test3", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.4", "Invalid delta-CRL Test4", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.6", "Invalid delta-CRL Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.9", "Invalid delta-CRL Test9", {bad_cert,{revoked, keyCompromise}}}]). + +%%----------------------------------------------------------------------------- + +valid_distribution_points(doc) -> + [""]; +valid_distribution_points(suite) -> + []; +valid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.1", "Valid distributionPoint Test1", ok}, + { "4.14.4", "Valid distributionPoint Test4", ok}, + { "4.14.5", "Valid distributionPoint Test5", ok}, + { "4.14.7", "Valid distributionPoint Test7", ok} + ]). + +valid_distribution_points_no_issuing_distribution_point(doc) -> + [""]; +valid_distribution_points_no_issuing_distribution_point(suite) -> + []; +valid_distribution_points_no_issuing_distribution_point(Config) when is_list(Config) -> + run([{ "4.14.10", "Valid No issuingDistributionPoint Test10", ok} + ]). + +invalid_distribution_points(doc) -> + [""]; +invalid_distribution_points(suite) -> + []; +invalid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.2", "Invalid distributionPoint Test2", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.3", "Invalid distributionPoint Test3", {bad_cert, + revocation_status_undetermined}}, + { "4.14.6", "Invalid distributionPoint Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.8", "Invalid distributionPoint Test8", {bad_cert, + revocation_status_undetermined}}, + { "4.14.9", "Invalid distributionPoint Test9", {bad_cert, + revocation_status_undetermined}} + ]). + +valid_only_contains(doc) -> + [""]; +valid_only_contains(suite) -> + []; +valid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}]). + +invalid_only_contains(doc) -> + [""]; +invalid_only_contains(suite) -> + []; +invalid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", + {bad_cert, revocation_status_undetermined}}, + { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_only_some_reasons(doc) -> + [""]; +valid_only_some_reasons(suite) -> + []; +valid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.18", "Valid onlySomeReasons Test18", ok}, + { "4.14.19", "Valid onlySomeReasons Test19", ok} + ]). + +invalid_only_some_reasons(doc) -> + [""]; +invalid_only_some_reasons(suite) -> + []; +invalid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.15", "Invalid onlySomeReasons Test15", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.16", "Invalid onlySomeReasons Test16", + {bad_cert,{revoked, certificateHold}}}, + { "4.14.17", "Invalid onlySomeReasons Test17", + {bad_cert, revocation_status_undetermined}}, + { "4.14.20", "Invalid onlySomeReasons Test20", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.21", "Invalid onlySomeReasons Test21", + {bad_cert,{revoked, affiliationChanged}}} + ]). + +valid_indirect_crl(doc) -> + [""]; +valid_indirect_crl(suite) -> + []; +valid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.22", "Valid IDP with indirectCRL Test22", ok}, + { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, + { "4.14.25", "Valid IDP with indirectCRL Test25", ok} + ]). + +invalid_indirect_crl(doc) -> + [""]; +invalid_indirect_crl(suite) -> + []; +invalid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.23", "Invalid IDP with indirectCRL Test23", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.26", "Invalid IDP with indirectCRL Test26", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_crl_issuer(doc) -> + [""]; +valid_crl_issuer(suite) -> + []; +valid_crl_issuer(Config) when is_list(Config) -> + run([{ "4.14.28", "Valid cRLIssuer Test28", ok}%%, + %%{ "4.14.29", "Valid cRLIssuer Test29", ok}, + %%{ "4.14.33", "Valid cRLIssuer Test33", ok} + ]). + +invalid_crl_issuer(doc) -> + [""]; +invalid_crl_issuer(suite) -> + []; +invalid_crl_issuer(Config) when is_list(Config) -> + run([ + { "4.14.27", "Invalid cRLIssuer Test27", {bad_cert, revocation_status_undetermined}}, + { "4.14.31", "Invalid cRLIssuer Test31", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.32", "Invalid cRLIssuer Test32", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.34", "Invalid cRLIssuer Test34", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.35", "Invalid cRLIssuer Test35", {bad_cert, revocation_status_undetermined}} + ]). + + +%%distribution_points() -> + %%{ "4.14", "Distribution Points" }, +%% [ + %% Although this test is valid it has a circular dependency. As a result + %% an attempt is made to reursively checks a CRL path and rejected due to + %% a CRL path validation error. PKITS notes suggest this test does not + %% need to be run due to this issue. +%% { "4.14.30", "Valid cRLIssuer Test30", 54 }]. + + +%%----------------------------------------------------------------------------- + +unknown_critical_extension(doc) -> + [""]; +unknown_critical_extension(suite) -> + []; +unknown_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", + {bad_cert,unknown_critical_extension}}]). + +unknown_not_critical_extension(doc) -> + [""]; +unknown_not_critical_extension(suite) -> + []; +unknown_not_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}]). + +%%----------------------------------------------------------------------------- run(Tests) -> File = file(?CERTS,"TrustAnchorRootCertificate.crt"), {ok, TA} = file:read_file(File), run(Tests, TA). run({Chap, Test, Result}, TA) -> - CertChain = sort_chain(read_certs(Test),TA, [], false), - try public_key:pkix_path_validation(TA, CertChain, []) of - {Result, _} -> ok; + CertChain = sort_chain(read_certs(Test),TA, [], false, Chap), + Options = path_validation_options(TA, Chap,Test), + try public_key:pkix_path_validation(TA, CertChain, Options) of + {Result, _} -> ok; {error,Result} when Result =/= ok -> ok; - {error,Error} when is_integer(Result) -> - ?warning(" ~p~n Got ~p expected ~p~n",[Test, Error, Result]); - {error,Error} when Result =/= ok -> - ?error(" minor ~p~n Got ~p expected ~p~n",[Test, Error, Result]); {error, Error} -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]), fail; - {ok, _} when Result =/= ok -> + {ok, _OK} when Result =/= ok -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]), fail catch Type:Reason -> @@ -181,14 +821,318 @@ run([Test|Rest],TA) -> run(Rest,TA); run([],_) -> ok. +path_validation_options(TA, Chap, Test) -> + case needs_crl_options(Chap) of + true -> + crl_options(TA, Test); + false -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {valid, UserState} + end, + [{verify_fun, {Fun, []}}] + end. + +needs_crl_options("4.4" ++ _) -> + true; +needs_crl_options("4.5" ++ _) -> + true; +needs_crl_options("4.7.4" ++ _) -> + true; +needs_crl_options("4.7.5" ++ _) -> + true; +needs_crl_options("4.14" ++ _) -> + true; +needs_crl_options("4.15" ++ _) -> + true; +needs_crl_options(_) -> + false. + +crl_options(TA, Test) -> + case read_crls(Test) of + [] -> + []; + CRLs -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, + #'Extension'{extnID = ?'id-ce-cRLDistributionPoints', + extnValue = Value}}, UserState0) -> + UserState = update_crls(Value, UserState0), + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (OtpCert, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {ErlCerts, CRLs} = UserState#verify_state.crl_info, + CRLInfo0 = + crl_info(OtpCert, + ErlCerts,[{DerCRL, public_key:der_decode('CertificateList', + DerCRL)} || DerCRL <- CRLs], + []), + CRLInfo = lists:reverse(CRLInfo0), + Certs = UserState#verify_state.certs_db, + Fun = fun(DP, CRLtoValidate, Id, CertsDb) -> + trusted_cert_and_path(DP, CRLtoValidate, Id, CertsDb) + end, + Ignore = ignore_sign_test_when_building_path(Test), + case public_key:pkix_crls_validate(OtpCert, CRLInfo, + [{issuer_fun,{Fun, {Ignore, Certs}}}]) of + valid -> + {valid, UserState}; + Reason -> + {fail, Reason} + end + end, + + Certs = read_certs(Test), + ErlCerts = [public_key:pkix_decode_cert(Cert, otp) || Cert <- Certs], + + [{verify_fun, {Fun, #verify_state{certs_db = [TA| Certs], + crl_info = {ErlCerts, CRLs}}}}] + end. + +crl_info(_, _, [], Acc) -> + Acc; +crl_info(OtpCert, Certs, [{_, #'CertificateList'{tbsCertList = + #'TBSCertList'{issuer = Issuer, + crlExtensions = CRLExtensions}}} + = CRL | Rest], Acc) -> + OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions, + ExtList = pubkey_cert:extensions_list(CRLExtensions), + DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of + #'Extension'{extnValue = Value} -> + lists:map(fun(Point) -> pubkey_cert_records:transform(Point, decode) end, Value); + _ -> + case same_issuer(OtpCert, Issuer) of + true -> + [make_dp(ExtList, asn1_NOVALUE, Issuer)]; + false -> + [make_dp(ExtList, Issuer, ignore)] + end + end, + DPsCRLs = lists:map(fun(DP) -> {DP, CRL} end, DPs), + crl_info(OtpCert, Certs, Rest, DPsCRLs ++ Acc). + +ignore_sign_test_when_building_path("Invalid Bad CRL Signature Test4") -> + true; +ignore_sign_test_when_building_path(_) -> + false. + +same_issuer(OTPCert, Issuer) -> + DecIssuer = pubkey_cert_records:transform(Issuer, decode), + OTPTBSCert = OTPCert#'OTPCertificate'.tbsCertificate, + CertIssuer = OTPTBSCert#'OTPTBSCertificate'.issuer, + pubkey_cert:is_issuer(DecIssuer, CertIssuer). + +make_dp(Extensions, Issuer0, DpInfo) -> + {Issuer, Point} = mk_issuer_dp(Issuer0, DpInfo), + case pubkey_cert:select_extension('id-ce-cRLReason', Extensions) of + #'Extension'{extnValue = Reasons} -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = Reasons, + distributionPoint = Point}; + _ -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = [unspecified, keyCompromise, + cACompromise, affiliationChanged, superseded, + cessationOfOperation, certificateHold, + removeFromCRL, privilegeWithdrawn, aACompromise], + distributionPoint = Point} + end. + +mk_issuer_dp(asn1_NOVALUE, Issuer) -> + {asn1_NOVALUE, {fullName, [{directoryName, Issuer}]}}; +mk_issuer_dp(Issuer, _) -> + {[{directoryName, Issuer}], asn1_NOVALUE}. + +update_crls(_, State) -> + State. + +trusted_cert_and_path(DP, CRL, Id, {Ignore, CertsList}) -> + case crl_issuer(crl_issuer_name(DP), CRL, Id, CertsList, CertsList, Ignore) of + {ok, IssuerCert, DerIssuerCert} -> + Certs = [{public_key:pkix_decode_cert(Cert, otp), Cert} || Cert <- CertsList], + CertChain = build_chain(Certs, Certs, IssuerCert, Ignore, [DerIssuerCert]), + {ok, public_key:pkix_decode_cert(hd(CertChain), otp), CertChain}; + Other -> + Other + end. + +crl_issuer_name(#'DistributionPoint'{cRLIssuer = asn1_NOVALUE}) -> + undefined; +crl_issuer_name(#'DistributionPoint'{cRLIssuer = [{directoryName, Issuer}]}) -> + pubkey_cert_records:transform(Issuer, decode). + +build_chain([],_, _, _,Acc) -> + Acc; + +build_chain([{First, DerFirst}|Certs], All, Cert, Ignore, Acc) -> + case public_key:pkix_is_self_signed(Cert) andalso is_test_root(Cert) of + true -> + Acc; + false -> + case public_key:pkix_is_issuer(Cert, First) + %%andalso check_extension_cert_signer(First) + andalso is_signer(First, Cert, Ignore) + of + true -> + build_chain(All, All, First, Ignore, [DerFirst | Acc]); + false -> + build_chain(Certs, All, Cert, Ignore, Acc) + end + end. + +is_signer(_,_, true) -> + true; +is_signer(Signer, #'OTPCertificate'{} = Cert,_) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + try pubkey_cert:validate_signature(Cert, public_key:pkix_encode('OTPCertificate', + Cert, otp), + PublicKey, PublicKeyParams, true, ?DEFAULT_VERIFYFUN) of + true -> + true + catch + _:_ -> + false + end; +is_signer(Signer, #'CertificateList'{} = CRL, _) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + pubkey_crl:verify_crl_signature(CRL, public_key:pkix_encode('CertificateList', + CRL, plain), + PublicKey, PublicKeyParams). + +is_test_root(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + {rdnSequence, AtterList} = TBSCert#'OTPTBSCertificate'.issuer, + lists:member([{'AttributeTypeAndValue',{2,5,4,3},{printableString,"Trust Anchor"}}], + AtterList). + +check_extension_cert_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(keyCertSign, KeyUse); + _ -> + true + end. + +check_extension_crl_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(cRLSign, KeyUse); + _ -> + true + end. + +crl_issuer(undefined, CRL, issuer_not_found, _, CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); + +crl_issuer(IssuerName, CRL, issuer_not_found, CertsList, CertsList, Ignore) -> + crl_issuer(IssuerName, CRL, IssuerName, CertsList, CertsList, Ignore); + +crl_issuer(undefined, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, Issuer} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(undefined, CRL, Id, Rest, All, false) + end; + +crl_issuer(IssuerName, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + %%Issuer = public_key:pkix_normalize_name( + %% TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, IssuerName} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + {_, IssuerName} when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(IssuerName, CRL, Id, Rest, All, false) + end; + +crl_issuer(undefined, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); +crl_issuer(CRLName, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRLName, CRL, CertsList, Ignore). + + +crl_issuer(_, [],_) -> + {error, issuer_not_found}; +crl_issuer(CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + case public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(CRL, Rest, Ignore) + end. + +crl_issuer(_,_, [],_) -> + {error, issuer_not_found}; +crl_issuer(IssuerName, CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + + case + public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + case pubkey_cert:is_issuer(Issuer, IssuerName) of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end. read_certs(Test) -> File = test_file(Test), - %% io:format("Read ~p ",[File]), Ders = erl_make_certs:pem_to_der(File), - %% io:format("Ders ~p ~n",[length(Ders)]), [Cert || {'Certificate', Cert, not_encrypted} <- Ders]. +read_crls(Test) -> + File = test_file(Test), + Ders = erl_make_certs:pem_to_der(File), + [CRL || {'CertificateList', CRL, not_encrypted} <- Ders]. + test_file(Test) -> file(?CONV, lists:append(string:tokens(Test, " -")) ++ ".pem"). @@ -206,118 +1150,89 @@ file(Sub,File) -> end, AbsFile. -sort_chain([First|Certs], TA, Try, Found) -> +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.3"-> + [CA, Entity, Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Self, Entity]; +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.4"; + Chap == "4.5.5" -> + [CA, Entity, _Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.24"; + Chap == "4.14.25"; + Chap == "4.14.26"; + Chap == "4.14.27"; + Chap == "4.14.31"; + Chap == "4.14.32"; + Chap == "4.14.33" -> + [_OtherCA, Entity, CA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.28"; + Chap == "4.14.29" -> + [CA, _OtherCA, Entity] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.33" -> + [Entity, CA, _OtherCA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) -> + do_sort_chain(Certs, TA, Acc, Bool, Chap). + +do_sort_chain([First], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> case public_key:pkix_is_issuer(First,TA) of true -> - [First|sort_chain(Certs,First,Try,true)]; + [First|do_sort_chain([],First,Try,true, Chap)]; false -> - sort_chain(Certs,TA,[First|Try],Found) + do_sort_chain([],TA,[First|Try],Found, Chap) end; -sort_chain([], _, [],_) -> []; -sort_chain([], Valid, Check, true) -> - sort_chain(lists:reverse(Check), Valid, [], false); -sort_chain([], _Valid, Check, false) -> +do_sort_chain([First|Certs], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> +%% case check_extension_cert_signer(public_key:pkix_decode_cert(First, otp)) of +%% true -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; +%% false -> +%% do_sort_chain(Certs, TA, Try, Found, Chap) +%% end; + +do_sort_chain([First|Certs], TA, Try, Found, Chap) -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; + +do_sort_chain([], _, [],_, _) -> []; +do_sort_chain([], Valid, Check, true, Chap) -> + do_sort_chain(lists:reverse(Check), Valid, [], false, Chap); +do_sort_chain([], _Valid, Check, false, _) -> Check. -signature_verification() -> - %% "4.1", "Signature Verification" , - [{ "4.1.1", "Valid Signatures Test1", ok}, - { "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, - { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}, - { "4.1.4", "Valid DSA Signatures Test4", ok}, - { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}, - { "4.1.6", "Invalid DSA Signature Test6", {bad_cert,invalid_signature}}]. -validity_periods() -> - %% { "4.2", "Validity Periods" }, - [{ "4.2.1", "Invalid CA notBefore Date Test1", {bad_cert, cert_expired}}, - { "4.2.2", "Invalid EE notBefore Date Test2", {bad_cert, cert_expired}}, - { "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, - { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}, - { "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, - { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, - { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7", {bad_cert, cert_expired}}, - { "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]. -verifying_name_chaining() -> - %%{ "4.3", "Verifying Name Chaining" }, - [{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, - { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}, - { "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, - { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}, - { "4.3.5", "Valid Name Chaining Capitalization Test5", ok}, - { "4.3.6", "Valid Name Chaining UIDs Test6", ok}, - { "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, - { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}, - { "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, - { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, - { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]. -basic_certificate_revocation_tests() -> - %%{ "4.4", "Basic Certificate Revocation Tests" }, - [{ "4.4.1", "Missing CRL Test1", 3 }, - { "4.4.2", "Invalid Revoked CA Test2", 23 }, - { "4.4.3", "Invalid Revoked EE Test3", 23 }, - { "4.4.4", "Invalid Bad CRL Signature Test4", 8 }, - { "4.4.5", "Invalid Bad CRL Issuer Name Test5", 3 }, - { "4.4.6", "Invalid Wrong CRL Test6", 3 }, - { "4.4.7", "Valid Two CRLs Test7", ok}, - - %% The test document suggests these should return certificate revoked... - %% Subsquent discussion has concluded they should not due to unhandle - %% critical CRL extensions. - { "4.4.8", "Invalid Unknown CRL Entry Extension Test8", 36 }, - { "4.4.9", "Invalid Unknown CRL Extension Test9", 36 }, - - { "4.4.10", "Invalid Unknown CRL Extension Test10", 36 }, - { "4.4.11", "Invalid Old CRL nextUpdate Test11", 12 }, - { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", 12 }, - { "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}, - { "4.4.14", "Valid Negative Serial Number Test14", ok}, - { "4.4.15", "Invalid Negative Serial Number Test15", 23 }, - { "4.4.16", "Valid Long Serial Number Test16", ok}, - { "4.4.17", "Valid Long Serial Number Test17", ok}, - { "4.4.18", "Invalid Long Serial Number Test18", 23 }, - { "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}, - { "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", 23 }, - - %% CRL path is revoked so get a CRL path validation error - { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", 54 }]. -verifying_paths_with_self_issued_certificates() -> - %%{ "4.5", "Verifying Paths with Self-Issued Certificates" }, - [{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, - %%{ "4.5.2", "Invalid Basic Self-Issued Old With New Test2", 23 }, - %%{ "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, - %%{ "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok}, - { "4.5.5", "Invalid Basic Self-Issued New With Old Test5", 23 }, - %%{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}, - { "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", 23 }, - { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", {bad_cert,invalid_key_usage} }]. -verifying_basic_constraints() -> - [%%{ "4.6", "Verifying Basic Constraints" }, - { "4.6.1", "Invalid Missing basicConstraints Test1", - {bad_cert, missing_basic_constraint} }, - { "4.6.2", "Invalid cA False Test2", {bad_cert, missing_basic_constraint}}, - { "4.6.3", "Invalid cA False Test3", {bad_cert, missing_basic_constraint}}, - { "4.6.4", "Valid basicConstraints Not Critical Test4", ok}, - { "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, - { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, - { "4.6.7", "Valid pathLenConstraint Test7", ok}, - { "4.6.8", "Valid pathLenConstraint Test8", ok}, - { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, - { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, - { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, - { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, - { "4.6.13", "Valid pathLenConstraint Test13", ok}, - { "4.6.14", "Valid pathLenConstraint Test14", ok}, - { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, - { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", {bad_cert, max_path_length_reached}}, - { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]. -key_usage() -> - %%{ "4.7", "Key Usage" }, - [{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", {bad_cert,invalid_key_usage} }, - { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", {bad_cert,invalid_key_usage} }, - { "4.7.3", "Valid keyUsage Not Critical Test3", ok} - %%,{ "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", 35 } - %%,{ "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", 35 } - ]. +error(Format, Args, File0, Line) -> + File = filename:basename(File0), + Pid = group_leader(), + Pid ! {failed, File, Line}, + io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). + +warning(Format, Args, File0, Line) -> + File = filename:basename(File0), + io:format("~s(~p): Warning "++Format, [File,Line|Args]). %% Certificate policy tests need special handling. They can have several %% sub tests and we need to check the outputs are correct. @@ -425,182 +1340,3 @@ inhibit_any_policy() -> {"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 }, {"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok}, {"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }]. - -name_constraints() -> - %%{ "4.13", "Name Constraints" }, - [{ "4.13.1", "Valid DN nameConstraints Test1", ok}, - { "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, - { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, - { "4.13.4", "Valid DN nameConstraints Test4", ok}, - { "4.13.5", "Valid DN nameConstraints Test5", ok}, - { "4.13.6", "Valid DN nameConstraints Test6", ok}, - { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, - { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, - { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, - { "4.13.10", "Invalid DN nameConstraints Test10", {bad_cert, name_not_permitted}}, - { "4.13.11", "Valid DN nameConstraints Test11", ok}, - { "4.13.12", "Invalid DN nameConstraints Test12", {bad_cert, name_not_permitted}}, - { "4.13.13", "Invalid DN nameConstraints Test13", {bad_cert, name_not_permitted}}, - { "4.13.14", "Valid DN nameConstraints Test14", ok}, - { "4.13.15", "Invalid DN nameConstraints Test15", {bad_cert, name_not_permitted}}, - { "4.13.16", "Invalid DN nameConstraints Test16", {bad_cert, name_not_permitted}}, - { "4.13.17", "Invalid DN nameConstraints Test17", {bad_cert, name_not_permitted}}, - { "4.13.18", "Valid DN nameConstraints Test18", ok}, - { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}, - { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", {bad_cert, name_not_permitted} }, - { "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, - { "4.13.22", "Invalid RFC822 nameConstraints Test22", {bad_cert, name_not_permitted} }, - { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, - { "4.13.24", "Invalid RFC822 nameConstraints Test24", {bad_cert, name_not_permitted} }, - { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}, - { "4.13.26", "Invalid RFC822 nameConstraints Test26", {bad_cert, name_not_permitted}}, - { "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}, - { "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", {bad_cert, name_not_permitted} }, - { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", {bad_cert, name_not_permitted} }, - { "4.13.30", "Valid DNS nameConstraints Test30", ok}, - { "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted} }, - { "4.13.32", "Valid DNS nameConstraints Test32", ok}, - { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, - { "4.13.34", "Valid URI nameConstraints Test34", ok}, - { "4.13.35", "Invalid URI nameConstraints Test35", {bad_cert, name_not_permitted} }, - { "4.13.36", "Valid URI nameConstraints Test36", ok}, - { "4.13.37", "Invalid URI nameConstraints Test37", {bad_cert, name_not_permitted}}, - { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted} }]. -distribution_points() -> - %%{ "4.14", "Distribution Points" }, - [{ "4.14.1", "Valid distributionPoint Test1", ok}, - { "4.14.2", "Invalid distributionPoint Test2", 23 }, - { "4.14.3", "Invalid distributionPoint Test3", 44 }, - { "4.14.4", "Valid distributionPoint Test4", ok}, - { "4.14.5", "Valid distributionPoint Test5", ok}, - { "4.14.6", "Invalid distributionPoint Test6", 23 }, - { "4.14.7", "Valid distributionPoint Test7", ok}, - { "4.14.8", "Invalid distributionPoint Test8", 44 }, - { "4.14.9", "Invalid distributionPoint Test9", 44 }, - { "4.14.10", "Valid No issuingDistributionPoint Test10", ok}, - { "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", 44 }, - { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", 44 }, - { "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}, - { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", 44 }, - { "4.14.15", "Invalid onlySomeReasons Test15", 23 }, - { "4.14.16", "Invalid onlySomeReasons Test16", 23 }, - { "4.14.17", "Invalid onlySomeReasons Test17", 3 }, - { "4.14.18", "Valid onlySomeReasons Test18", ok}, - { "4.14.19", "Valid onlySomeReasons Test19", ok}, - { "4.14.20", "Invalid onlySomeReasons Test20", 23 }, - { "4.14.21", "Invalid onlySomeReasons Test21", 23 }, - { "4.14.22", "Valid IDP with indirectCRL Test22", ok}, - { "4.14.23", "Invalid IDP with indirectCRL Test23", 23 }, - { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, - { "4.14.25", "Valid IDP with indirectCRL Test25", ok}, - { "4.14.26", "Invalid IDP with indirectCRL Test26", 44 }, - { "4.14.27", "Invalid cRLIssuer Test27", 3 }, - { "4.14.28", "Valid cRLIssuer Test28", ok}, - { "4.14.29", "Valid cRLIssuer Test29", ok}, - - %% Although this test is valid it has a circular dependency. As a result - %% an attempt is made to reursively checks a CRL path and rejected due to - %% a CRL path validation error. PKITS notes suggest this test does not - %% need to be run due to this issue. - { "4.14.30", "Valid cRLIssuer Test30", 54 }, - { "4.14.31", "Invalid cRLIssuer Test31", 23 }, - { "4.14.32", "Invalid cRLIssuer Test32", 23 }, - { "4.14.33", "Valid cRLIssuer Test33", ok}, - { "4.14.34", "Invalid cRLIssuer Test34", 23 }, - { "4.14.35", "Invalid cRLIssuer Test35", 44 }]. -delta_crls() -> - %%{ "4.15", "Delta-CRLs" }, - [{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1", 3 }, - { "4.15.2", "Valid delta-CRL Test2", ok}, - { "4.15.3", "Invalid delta-CRL Test3", 23 }, - { "4.15.4", "Invalid delta-CRL Test4", 23 }, - { "4.15.5", "Valid delta-CRL Test5", ok}, - { "4.15.6", "Invalid delta-CRL Test6", 23 }, - { "4.15.7", "Valid delta-CRL Test7", ok}, - { "4.15.8", "Valid delta-CRL Test8", ok}, - { "4.15.9", "Invalid delta-CRL Test9", 23 }, - { "4.15.10", "Invalid delta-CRL Test10", 12 }]. -private_certificate_extensions() -> - %%{ "4.16", "Private Certificate Extensions" }, - [{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}, - { "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", - {bad_cert,unknown_critical_extension}}]. - - -convert() -> - Tests = [signature_verification(), - validity_periods(), - verifying_name_chaining(), - basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - certificate_policies(), - require_explicit_policy(), - policy_mappings(), - inhibit_policy_mapping(), - inhibit_any_policy(), - name_constraints(), - distribution_points(), - delta_crls(), - private_certificate_extensions()], - [convert(Test) || Test <- lists:flatten(Tests)]. - -convert({_,Test,_}) -> - convert1(Test); -convert({_,Test,_,_,_,_,_}) -> - convert1(Test). - -convert1(Test) -> - FName = lists:append(string:tokens(Test, " -")), - File = filename:join(?MIME, "Signed" ++ FName ++ ".eml"), - io:format("Convert ~p~n",[File]), - {ok, Mail} = file:read_file(File), - Base64 = skip_lines(Mail), - %%io:format("~s",[Base64]), - Tmp = base64:mime_decode(Base64), - file:write_file("pkits/smime-pem/tmp-pkcs7.der", Tmp), - Cmd = "openssl pkcs7 -inform der -in pkits/smime-pem/tmp-pkcs7.der" - " -print_certs -out pkits/smime-pem/" ++ FName ++ ".pem", - case os:cmd(Cmd) of - "" -> ok; - Err -> - io:format("~s",[Err]), - erlang:error(bad_cmd) - end. - -skip_lines(<<"\r\n\r\n", Rest/binary>>) -> Rest; -skip_lines(<<"\n\n", Rest/binary>>) -> Rest; -skip_lines(<<_:8, Rest/binary>>) -> - skip_lines(Rest). - -init_per_testcase(_Func, Config) -> - Datadir = proplists:get_value(data_dir, Config), - put(datadir, Datadir), - Config. - -end_per_testcase(_Func, Config) -> - %% Nodes = select_nodes(all, Config, ?FILE, ?LINE), - %% rpc:multicall(Nodes, mnesia, lkill, []), - Config. - -init_per_suite(Config) -> - try crypto:start() of - ok -> - Config - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(_Config) -> - application:stop(crypto). - -error(Format, Args, File0, Line) -> - File = filename:basename(File0), - Pid = group_leader(), - Pid ! {failed, File, Line}, - io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). - -warning(Format, Args, File0, Line) -> - File = filename:basename(File0), - io:format("~s(~p): Warning "++Format, [File,Line|Args]). diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index c99fd6fee1..3c6b012152 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.11 +PUBLIC_KEY_VSN = 0.12 diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl index 38e486b7a7..13753565d8 100644 --- a/lib/sasl/src/rb.erl +++ b/lib/sasl/src/rb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -169,7 +169,7 @@ print_filters() -> print_dates() -> io:format(" - {StartDate, EndDate}~n"), - io:format(" StartDate = EndDate = {{Y-M-D},{H,M,S}} ~n"), + io:format(" StartDate = EndDate = {{Y,M,D},{H,M,S}} ~n"), io:format(" prints the reports with date between StartDate and EndDate~n"), io:format(" - {StartDate, from}~n"), io:format(" prints the reports with date greater than StartDate~n"), diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index af667b1a71..4f546a37ed 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,33 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.0.6</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A memory leak has been fixed. I.e. per terminated connection the size of + a pid and the length of a user name string was not cleared.</p> + <p> + Own Id: OTP-9232</p> + </item> + </list> + </section> +</section> + +<section><title>Ssh 2.0.5</title> + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> +</section> + <section><title>Ssh 2.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 501da8ceb9..37f24e2463 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,34 +19,12 @@ {"%VSN%", [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ], [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ] }. diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 399581a0fd..3f0a06575c 100755 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ %% integer utils -export([isize/1]). -export([irandom/1, irandom/3]). --export([random/1, random/3]). +-export([random/1]). -export([xor_bits/2, fill_bits/2]). -export([i2bin/2, bin2i/1]). @@ -401,9 +401,6 @@ xor_bits(XBits, YBits) -> irandom(Bits) -> irandom(Bits, 1, 0). -%% irandom_odd(Bits) -> -%% irandom(Bits, 1, 1). - %% %% irandom(N, Top, Bottom) %% @@ -414,57 +411,16 @@ irandom(Bits) -> %% Bot = 0 - do not set the least signifcant bit %% Bot = 1 - set the least signifcant bit (i.e always odd) %% -irandom(0, _Top, _Bottom) -> - 0; -irandom(Bits, Top, Bottom) -> - Bytes = (Bits+7) div 8, - Skip = (8-(Bits rem 8)) rem 8, - TMask = case Top of - 0 -> 0; - 1 -> 16#80; - 2 -> 16#c0 - end, - BMask = case Bottom of - 0 -> 0; - 1 -> (1 bsl Skip) - end, - <<X:Bits/big-unsigned-integer, _:Skip>> = random(Bytes, TMask, BMask), - X. +irandom(Bits, Top, Bottom) when is_integer(Top), + 0 =< Top, Top =< 2 -> + crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)). %% %% random/1 %% Generate N random bytes %% random(N) -> - random(N, 0, 0). - -random(N, TMask, BMask) -> - list_to_binary(rnd(N, TMask, BMask)). - -%% random/3 -%% random(Bytes, TopMask, BotMask) -%% where -%% Bytes is the number of bytes to generate -%% TopMask is bitwised or'ed to the first byte -%% BotMask is bitwised or'ed to the last byte -%% -rnd(0, _TMask, _BMask) -> - []; -rnd(1, TMask, BMask) -> - [(rand8() bor TMask) bor BMask]; -rnd(N, TMask, BMask) -> - [(rand8() bor TMask) | rnd_n(N-1, BMask)]. - -rnd_n(1, BMask) -> - [rand8() bor BMask]; -rnd_n(I, BMask) -> - [rand8() | rnd_n(I-1, BMask)]. - -rand8() -> - (rand32() bsr 8) band 16#ff. - -rand32() -> - random:uniform(16#100000000) -1. + crypto:strong_rand_bytes(N). %% %% Base 64 encode/decode diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index cb78acb84c..781e01b9d1 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 0ba11b0a26..3193be2510 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,8 +106,6 @@ peer_address(ConnectionHandler) -> %% initialize. %%-------------------------------------------------------------------- init([Role, Manager, Socket, SshOpts]) -> - {A,B,C} = erlang:now(), - random:seed(A, B, C), {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), ssh_bits:install_messages(ssh_transport:transport_messages(NumVsn)), {Protocol, Callback, CloseTag} = @@ -580,7 +578,9 @@ handle_info({CloseTag, _Socket}, _StateName, %% Reason. The return value is ignored. %%-------------------------------------------------------------------- terminate(normal, _, #state{transport_cb = Transport, - socket = Socket}) -> + socket = Socket, + manager = Pid}) -> + (catch ssh_userreg:delete_user(Pid)), (catch Transport:close(Socket)), ok; @@ -812,7 +812,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg, #state{ssh_params = Ssh0, manager = Pid} = State) -> {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), try - send_msg(SshPacket, State), + send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg) catch exit:{noproc, _Reason} -> @@ -824,6 +824,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg, [Msg, Exit]), error_logger:info_report(Report) end, + (catch ssh_userreg:delete_user(Pid)), {stop, normal, State#state{ssh_params = Ssh}}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> diff --git a/lib/ssh/src/ssh_userreg.erl b/lib/ssh/src/ssh_userreg.erl index 33c801f490..f901461aea 100644 --- a/lib/ssh/src/ssh_userreg.erl +++ b/lib/ssh/src/ssh_userreg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,11 +25,18 @@ -behaviour(gen_server). %% API --export([start_link/0, register_user/2, lookup_user/1]). +-export([start_link/0, + register_user/2, + lookup_user/1, + delete_user/1]). %% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). -record(state, {user_db = []}). @@ -46,6 +53,9 @@ start_link() -> register_user(User, Cm) -> gen_server:cast(?MODULE, {register, {User, Cm}}). +delete_user(Cm) -> + gen_server:cast(?MODULE, {delete, Cm}). + lookup_user(Cm) -> gen_server:call(?MODULE, {get_user, Cm}, infinity). @@ -82,9 +92,10 @@ handle_call({get_user, Cm}, _From, #state{user_db = Db} = State) -> %% {stop, Reason, State} %% Description: Handling cast messages %%-------------------------------------------------------------------- -handle_cast({register, UserCm}, State0) -> - State = insert(UserCm, State0), - {noreply, State}. +handle_cast({register, UserCm}, State) -> + {noreply, insert(UserCm, State)}; +handle_cast({delete, UserCm}, State) -> + {noreply, delete(UserCm, State)}. %%-------------------------------------------------------------------- %% Function: handle_info(Info, State) -> {noreply, State} | @@ -118,6 +129,9 @@ code_change(_OldVsn, State, _Extra) -> insert({User, Cm}, #state{user_db = Db} = State) -> State#state{user_db = [{User, Cm} | Db]}. +delete(Cm, #state{user_db = Db} = State) -> + State#state{user_db = lists:keydelete(Cm, 2, Db)}. + lookup(_, []) -> undefined; lookup(Cm, [{User, Cm} | _Rest]) -> diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 51f9f47446..d0861b3ddc 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.0.4 +SSH_VSN = 2.0.6 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index cd5c9281cd..0da6bbee5b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -53,13 +53,11 @@ <p>The following data types are used in the functions below: </p> - <p><c>boolean() = true | false</c></p> - - <p><c>property() = atom()</c></p> - + <p><c>boolean() = true | false</c></p> + <p><c>option() = socketoption() | ssloption() | transportoption()</c></p> - <p><c>socketoption() = [{property(), term()}] - defaults to + <p><c>socketoption() = proplists:property() - The default socket options are [{mode,list},{packet, 0},{header, 0},{active, true}]. </c></p> @@ -266,7 +264,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <p>Possible path validation errors: </p> -<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> +<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> </item> <tag>{hibernate_after, integer()|undefined}</tag> @@ -488,7 +486,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <fsummary>Get the value of the specified options.</fsummary> <type> <v>Socket = sslsocket()</v> - <v>OptionNames = [property()]</v> + <v>OptionNames = [atom()]</v> </type> <desc> <p>Get the value of the specified socket options, if no @@ -583,7 +581,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <fsummary>Write data to a socket.</fsummary> <type> <v>Socket = sslsocket()</v> - <v>Data = iolist() | binary()</v> + <v>Data = iodata()</v> </type> <desc> <p>Writes <c>Data</c> to <c>Socket</c>. </p> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index d3e426f254..a0ecb4ac6f 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, @@ -8,6 +9,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 7b1fda4cf9..380c59b058 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -50,8 +50,7 @@ cb %% Callback info }). -type option() :: socketoption() | ssloption() | transportoption(). --type socketoption() :: [{property(), term()}]. %% See gen_tcp and inet --type property() :: atom(). +-type socketoption() :: term(). %% See gen_tcp and inet, import spec later when there is one to import -type ssloption() :: {verify, verify_type()} | {verify_fun, {fun(), InitialUserState::term()}} | {fail_if_no_peer_cert, boolean()} | {depth, integer()} | @@ -264,7 +263,7 @@ close(Socket = #sslsocket{}) -> ssl_broker:close(Socket). %%-------------------------------------------------------------------- --spec send(#sslsocket{}, iolist()) -> ok | {error, reason()}. +-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- @@ -403,9 +402,9 @@ cipher_suites(openssl) -> [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]. %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}. +-spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]} | {error, reason()}. %% -%% Description: +%% Description: Gets options %%-------------------------------------------------------------------- getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptTags) when is_pid(Pid) -> ssl_connection:get_opts(Pid, OptTags); @@ -416,9 +415,9 @@ getopts(#sslsocket{} = Socket, Options) -> ssl_broker:getopts(Socket, Options). %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [{atom(), term()}]) -> ok | {error, reason()}. +-spec setopts(#sslsocket{}, [proplist:property()]) -> ok | {error, reason()}. %% -%% Description: +%% Description: Sets options %%-------------------------------------------------------------------- setopts(#sslsocket{fd = new_ssl, pid = Pid}, Opts0) when is_pid(Pid) -> Opts = proplists:expand([{binary, [{mode, binary}]}, diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 574e1e9468..0a86e9bd29 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -107,12 +107,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec send(pid(), iolist()) -> ok | {error, reason()}. +-spec send(pid(), iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> sync_send_all_state_event(Pid, {application_data, + %% iolist_to_binary should really + %% be called iodata_to_binary() erlang:iolist_to_binary(Data)}, infinity). %%-------------------------------------------------------------------- diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 2f1edfa186..0e80e42637 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 4.1.4 +SSL_VSN = 4.1.5 diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 45fa0847a8..d6203bdaa0 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -83,11 +83,17 @@ supervisor, where all child processes are dynamically added instances of the same process type, i.e. running the same code.</p> - <p>The functions <c>terminate_child/2</c>, <c>delete_child/2</c> + <p>The functions <c>delete_child/2</c> and <c>restart_child/2</c> are invalid for <c>simple_one_for_one</c> supervisors and will return <c>{error,simple_one_for_one}</c> if the specified supervisor uses this restart strategy.</p> + <p>The function <c>terminate_child/2</c> can be used for + children under <c>simple_one_for_one</c> supervisors by + giving the child's <c>pid()</c> as the second argument. If + instead the child specification identifier is used, + <c>terminate_child/2</c> will return + <c>{error,simple_one_for_one}</c>.</p> </item> </list> <p>To prevent a supervisor from getting into an infinite loop of @@ -311,24 +317,33 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <type> <v>SupRef = Name | {Name,Node} | {global,Name} | pid()</v> <v> Name = Node = atom()</v> - <v>Id = term()</v> + <v>Id = pid() | term()</v> <v>Result = ok | {error,Error}</v> <v> Error = not_found | simple_one_for_one</v> </type> <desc> - <p>Tells the supervisor <c>SupRef</c> to terminate the child - process corresponding to the child specification identified - by <c>Id</c>. The process, if there is one, is terminated but - the child specification is kept by the supervisor. This means - that the child process may be later be restarted by - the supervisor. The child process can also be restarted - explicitly by calling <c>restart_child/2</c>. Use - <c>delete_child/2</c> to remove the child specification.</p> + <p>Tells the supervisor <c>SupRef</c> to terminate the given + child.</p> + <p>If the supervisor is not <c>simple_one_for_one</c>, + <c>Id</c> must be the child specification identifier. The + process, if there is one, is terminated but the child + specification is kept by the supervisor. The child process + may later be restarted by the supervisor. The child process + can also be restarted explicitly by calling + <c>restart_child/2</c>. Use <c>delete_child/2</c> to remove + the child specification.</p> + <p>If the supervisor is <c>simple_one_for_one</c>, <c>Id</c> + must be the child process' <c>pid()</c>. I the specified + process is alive, but is not a child of the given + supervisor, the function will return + <c>{error,not_found}</c>. If the child specification + identifier is given instead instead of a <c>pid()</c>, the + function will return <c>{error,simple_one_for_one}</c>.</p> + <p>If successful, the function returns <c>ok</c>. If there is + no child specification with the specified <c>Id</c>, the + function returns <c>{error,not_found}</c>.</p> <p>See <c>start_child/2</c> for a description of <c>SupRef</c>.</p> - <p>If successful, the function returns <c>ok</c>. If there is - no child specification with the specified <c>Id</c>, - the function returns <c>{error,not_found}</c>.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml index e3a25a407b..cb1cfa8ed0 100644 --- a/lib/stdlib/doc/src/unicode.xml +++ b/lib/stdlib/doc/src/unicode.xml @@ -164,10 +164,16 @@ latin1_charlist() = [latin1_char() | latin1_binary() | latin1_charlist()] <item>Integers out of range - If <c>InEncoding</c> is <c>latin1</c>, an error occurs whenever an integer greater than 255 is found in the lists. If <c>InEncoding</c> is - of a Unicode type, error occurs whenever an integer greater than - <c>16#10FFFF</c> (the maximum unicode character) or in the - range <c>16#D800</c> to <c>16#DFFF</c> (invalid unicode - range) is found.</item> + of a Unicode type, an error occurs whenever an integer + <list type="bulleted"> + <item>greater than <c>16#10FFFF</c> + (the maximum unicode character),</item> + <item>in the range <c>16#D800</c> to <c>16#DFFF</c> + (invalid unicode range)</item> + <item>or equal to 16#FFFE or 16#FFFF (non characters)</item> + </list> + is found. + </item> <item>UTF encoding incorrect - If <c>InEncoding</c> is one of the UTF types, the bytes in any binaries have to be valid diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 43df6f621d..574146b1cd 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -29,6 +29,8 @@ -export([init_it/6, init_it/7]). +-export([format_status_header/2]). + -define(default_timeout, 5000). %%----------------------------------------------------------------- @@ -315,3 +317,10 @@ debug_options(Opts) -> {ok, Options} -> sys:debug_options(Options); _ -> [] end. + +format_status_header(TagLine, Pid) when is_pid(Pid) -> + lists:concat([TagLine, " ", pid_to_list(Pid)]); +format_status_header(TagLine, RegName) when is_atom(RegName) -> + lists:concat([TagLine, " ", RegName]); +format_status_header(TagLine, Name) -> + {TagLine, Name}. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index b1e9e3a02f..b00910771f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -724,7 +724,8 @@ get_modules(MSL) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, - Header = lists:concat(["Status for event handler ", ServerName]), + Header = gen:format_status_header("Status for event handler", + ServerName), FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of true -> Args = [PDict, State], diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 7d9960b912..f2f1365d3d 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -614,15 +614,8 @@ get_msg(Msg) -> Msg. format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] = StatusData, - StatusHdr = "Status for state machine", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for state machine", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"StateData", StateData}]}], Specfic = diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index ac81df9cab..09d94a9c40 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -840,15 +840,8 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - StatusHdr = "Status for generic server", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for generic server", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"State", State}]}], Specfic = diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index 7f5f23e26d..a3c9927ee9 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -95,6 +95,9 @@ pspawn_link(M, F, A) -> start_nodes([], _, _) -> []; start_nodes([Host|Tail], Name, Args) -> case slave:start(Host, Name, Args) of + {error, {already_running, Node}} -> + io:format("Can't start node on host ~w due to ~w~n",[Host, {already_running, Node}]), + [Node | start_nodes(Tail, Name, Args)]; {error, R} -> io:format("Can't start node on host ~w due to ~w~n",[Host, R]), start_nodes(Tail, Name, Args); diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 368dc2e3e5..4fd7f1d47c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -138,7 +138,7 @@ delete_child(Supervisor, Name) -> %%----------------------------------------------------------------- -type term_err() :: 'not_found' | 'simple_one_for_one'. --spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}. +-spec terminate_child(sup_ref(), pid() | term()) -> 'ok' | {'error', term_err()}. terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). @@ -297,8 +297,26 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> {reply, What, State} end; -%%% The requests terminate_child, delete_child and restart_child are -%%% invalid for simple_one_for_one supervisors. +%% terminate_child for simple_one_for_one can only be done with pid +handle_call({terminate_child, Name}, _From, State) when not is_pid(Name), + ?is_simple(State) -> + {reply, {error, simple_one_for_one}, State}; + +handle_call({terminate_child, Name}, _From, State) -> + case get_child(Name, State, ?is_simple(State)) of + {value, Child} -> + case do_terminate(Child, State#state.name) of + #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) -> + {reply, ok, state_del_child(Child, State)}; + NChild -> + {reply, ok, replace_child(NChild, State)} + end; + false -> + {reply, {error, not_found}, State} + end; + +%%% The requests delete_child and restart_child are invalid for +%%% simple_one_for_one supervisors. handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; @@ -341,19 +359,6 @@ handle_call({delete_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -handle_call({terminate_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} -> - case do_terminate(Child, State#state.name) of - #child{restart_type = temporary} = NChild -> - {reply, ok, state_del_child(NChild, State)}; - NChild -> - {reply, ok, replace_child(NChild, State)} - end; - _ -> - {reply, {error, not_found}, State} - end; - handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT, modules = Mods}]} = @@ -849,7 +854,28 @@ split_child(_, [], After) -> {lists:reverse(After), []}. get_child(Name, State) -> + get_child(Name, State, false). +get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> + get_dynamic_child(Pid, State); +get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). + +get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> + case is_dynamic_pid(Pid, dynamics_db(Child#child.restart_type, Dynamics)) of + true -> + {value, Child#child{pid=Pid}}; + false -> + case erlang:is_process_alive(Pid) of + true -> false; + false -> {value, Child} + end + end. + +is_dynamic_pid(Pid, Dynamics) when is_list(Dynamics) -> + lists:member(Pid, Dynamics); +is_dynamic_pid(Pid, Dynamics) -> + dict:is_key(Pid, Dynamics). + replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), State#state{children = Chs}. diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 9e3e717e7d..b3a7edc140 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -25,13 +25,14 @@ -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, - call_format_status/1, error_format_status/1]). + call_format_status/1, call_format_status_anon/1, + error_format_status/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [start, {group, test_all}, hibernate, - call_format_status, error_format_status]. + call_format_status, call_format_status_anon, error_format_status]. groups() -> [{test_all, [], @@ -888,6 +889,22 @@ call_format_status(Config) when is_list(Config) -> ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, ok. +call_format_status_anon(suite) -> + []; +call_format_status_anon(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2 for anonymous gen_event processes"]; +call_format_status_anon(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start(), + %% The 'Name' of the gen_event process will be a pid() here, so + %% the next line will crash if format_status can't string-ify pids. + ?line Status1 = sys:get_status(Pid), + ?line ok = gen_event:stop(Pid), + Header = "Status for event handler " ++ pid_to_list(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line Header = proplists:get_value(header, Data1), + ok. + + error_format_status(suite) -> []; error_format_status(doc) -> diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index f9ceed8f84..cc271bd047 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -20,7 +20,7 @@ -module(supervisor_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). -define(TIMEOUT, 1000). %% Testserver specific export @@ -349,8 +349,7 @@ child_adm(Config) when is_list(Config) -> ok = supervisor:terminate_child(sup_test, child1), %% Start of already existing but not running process - {error,already_present} = - supervisor:start_child(sup_test, Child), + {error,already_present} = supervisor:start_child(sup_test, Child), %% Restart {ok, CPid2} = supervisor:restart_child(sup_test, child1), @@ -377,6 +376,11 @@ child_adm(Config) when is_list(Config) -> [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), [1,1,0,1] = get_child_counts(sup_test), + %% Terminate with Pid not allowed when not simple_one_for_one + {error,not_found} = supervisor:terminate_child(sup_test, CPid3), + [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + {'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}} = (catch supervisor:which_children(foo)), {'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}} @@ -412,16 +416,26 @@ child_adm_simple(Config) when is_list(Config) -> [1,2,0,2] = get_child_counts(sup_test), %% Termination - {error, simple_one_for_one} = - supervisor:terminate_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:terminate_child(sup_test, child1), + [1,2,0,2] = get_child_counts(sup_test), + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + false = erlang:is_process_alive(CPid1), + %% Terminate non-existing proccess is ok + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + %% Terminate pid which is not a child of this supervisor is not ok + NoChildPid = spawn_link(fun() -> receive after infinity -> ok end end), + {error, not_found} = supervisor:terminate_child(sup_test, NoChildPid), + true = erlang:is_process_alive(NoChildPid), %% Restart - {error, simple_one_for_one} = - supervisor:restart_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:restart_child(sup_test, child1), %% Deletion - {error, simple_one_for_one} = - supervisor:delete_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:delete_child(sup_test, child1), ok. %%------------------------------------------------------------------------- diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7f0011bd68..591329b361 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -36,7 +36,7 @@ -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). -export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). --export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]). +-export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1,timetrap_cancel/0]). -export([m_out_of_n/3,do_times/4,do_times/2]). -export([call_crash/3,call_crash/4,call_crash/5]). -export([temp_name/1]). @@ -1077,7 +1077,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {{Time,Value},Loc,Opts} = case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok, Args0}) of + {ok,Args0}) of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> @@ -1085,18 +1085,17 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {skip,{failed,Error}}), {{0,NewResult},{Mod,Func},[]}; {fail,Reason} -> - [Conf] = Args0, - Conf1 = [{tc_status,{failed,Reason}} | Conf], + Conf = [{tc_status,{failed,Reason}} | hd(Args0)], fw_error_notify(Mod, Func, Conf, Reason), - NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf1]}, - {fail, Reason}), + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]}, + {fail,Reason}), {{0,NewResult},{Mod,Func},[]}; Skip = {skip,_Reason} -> NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip), {{0,NewResult},{Mod,Func},[]}; {auto_skip,Reason} -> NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0}, - {skip, {fw_auto_skip,Reason}}), + {skip,{fw_auto_skip,Reason}}), {{0,NewResult},{Mod,Func},[]} end, exit({Ref,Time,Value,Loc,Opts}). @@ -1116,9 +1115,15 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], - NewRes = do_end_tc_call(Mod, Func, {{skip, Reason}, [Conf]}, + NewRes = do_end_tc_call(Mod, Func, {{skip,Reason},[Conf]}, {skip, Reason}), {{0,NewRes},Line,[]}; + FailTC = {fail,Reason} -> % user fails the testcase + EndConf = [{tc_status,{failed,Reason}} | hd(Args)], + fw_error_notify(Mod, Func, EndConf, Reason), + NewRes = do_end_tc_call(Mod, Func, {{error,Reason},[EndConf]}, + FailTC), + {{0,NewRes},{Mod,Func},[]}; {ok,NewConf} -> put(test_server_init_or_end_conf,undefined), %% call user callback function if defined @@ -1153,8 +1158,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> - {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config, 1, EndConf1)]}; - {fail,ReasonToFail} -> % user has failed the testcase + {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1, + EndConf1)]}; + {fail,ReasonToFail} -> % user has failed the testcase fw_error_notify(Mod, Func, EndConf1, ReasonToFail), {{error,ReasonToFail},{failed,ReasonToFail},EndConf1}; {failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination @@ -1193,11 +1199,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> do_end_tc_call(M,F,Res,Return) -> Ref = make_ref(), - case test_server_sup:framework_call( - end_tc, [?pl2a(M),F,Res], Ref) of - {fail,FWReason} -> - {failed,FWReason}; - Ref -> + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW == "ct_framework"; + FW == "undefined"; + FW == false -> case test_server_sup:framework_call( end_tc, [?pl2a(M),F,Res, Return], ok) of {fail,FWReason} -> @@ -1212,8 +1217,14 @@ do_end_tc_call(M,F,Res,Return) -> NewReturn -> NewReturn end; - _ -> - Return + Other -> + case test_server_sup:framework_call( + end_tc, [Other,F,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + _Else -> + Return + end end. %% the return value is a list and we have to check if it contains @@ -1296,7 +1307,7 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, -%% init_per_testcase defined, returns new configuration + %% init_per_testcase defined, returns new configuration case erlang:function_exported(Mod,init_per_testcase,2) of true -> case catch my_apply(Mod, init_per_testcase, [Func|Args]) of @@ -1316,6 +1327,8 @@ init_per_testcase(Mod, Func, Args) -> "bad elements in Config: ~p\n",[Bad]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} end; + {'$test_server_ok',Res={fail,_Reason}} -> + Res; {'$test_server_ok',_Other} -> group_leader() ! {printout,12, "ERROR! init_per_testcase did not return " @@ -1690,7 +1703,7 @@ fail() -> break(Comment) -> case erase(test_server_timetraps) of undefined -> ok; - List -> lists:foreach(fun(Ref) -> timetrap_cancel(Ref) end,List) + List -> lists:foreach(fun({Ref,_}) -> timetrap_cancel(Ref) end, List) end, io:format(user, "\n\n\n--- SEMIAUTOMATIC TESTING ---" @@ -1771,14 +1784,16 @@ timetrap(Timeout0) -> {undefined,false} -> timetrap1(Timeout, false); {undefined,_} -> timetrap1(Timeout, true); {infinity,_} -> infinity; + {_Int,_Scale} when Timeout == infinity -> infinity; {Int,Scale} -> timetrap1(Timeout*Int, Scale) end. timetrap1(Timeout, Scale) -> - Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,self()]), + TCPid = self(), + Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]), case get(test_server_timetraps) of - undefined -> put(test_server_timetraps,[Ref]); - List -> put(test_server_timetraps,[Ref|List]) + undefined -> put(test_server_timetraps,[{Ref,TCPid}]); + List -> put(test_server_timetraps,[{Ref,TCPid}|List]) end, Ref. @@ -1791,14 +1806,16 @@ ensure_timetrap(Config) -> undefined -> ok; Garbage -> erase(test_server_default_timetrap), - format("=== WARNING: garbage in test_server_default_timetrap: ~p~n", + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", [Garbage]) end, DTmo = case lists:keysearch(default_timeout,1,Config) of {value,{default_timeout,Tmo}} -> Tmo; _ -> ?DEFAULT_TIMETRAP_SECS end, - format("=== test_server setting default timetrap of ~p seconds~n", + format("=== test_server setting default " + "timetrap of ~p seconds~n", [DTmo]), put(test_server_default_timetrap, timetrap(seconds(DTmo))) end. @@ -1810,11 +1827,13 @@ cancel_default_timetrap() -> TimeTrap when is_pid(TimeTrap) -> timetrap_cancel(TimeTrap), erase(test_server_default_timetrap), - format("=== test_server canceled default timetrap since another timetrap was set~n"), + format("=== test_server canceled default timetrap " + "since another timetrap was set~n"), ok; Garbage -> erase(test_server_default_timetrap), - format("=== WARNING: garbage in test_server_default_timetrap: ~p~n", + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", [Garbage]), error end. @@ -1828,6 +1847,7 @@ time_ms({Other,_N}) -> "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_spec,Other}); time_ms(Ms) when is_integer(Ms) -> Ms; +time_ms(infinity) -> infinity; time_ms(Other) -> exit({invalid_time_spec,Other}). @@ -1841,11 +1861,29 @@ timetrap_cancel(infinity) -> timetrap_cancel(Handle) -> case get(test_server_timetraps) of undefined -> ok; - [Handle] -> erase(test_server_timetraps); - List -> put(test_server_timetraps,lists:delete(Handle,List)) + [{Handle,_}] -> erase(test_server_timetraps); + Timers -> put(test_server_timetraps, + lists:keydelete(Handle, 1, Timers)) end, test_server_sup:timetrap_cancel(Handle). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_cancel() -> ok +%% +%% Cancels timetrap for current test case. +timetrap_cancel() -> + case get(test_server_timetraps) of + undefined -> + ok; + Timers -> + case lists:keysearch(self(), 2, Timers) of + {value,{Handle,_}} -> + timetrap_cancel(Handle); + _ -> + ok + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% hours(N) -> Milliseconds %% minutes(N) -> Milliseconds diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 30d7314058..de9b962dfc 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1812,6 +1812,9 @@ start_log_file() -> ok = file:make_dir(PrivDir), put(test_server_priv_dir,PrivDir++"/"), print_timestamp(13,"Suite started at "), + + LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir)}], + test_server_sup:framework_call(report, [loginfo,LogInfo]), ok. make_html_link(LinkName, Target, Explanation) -> @@ -1925,7 +1928,6 @@ html_convert_modules(TestSpec, _Config) -> copy_html_files(get(test_server_dir), get(test_server_log_dir_base)). %% Retrieve a list of modules out of the test spec. - html_isolate_modules(List) -> html_isolate_modules(List, sets:new()). html_isolate_modules([], Set) -> sets:to_list(Set); @@ -1939,37 +1941,56 @@ html_isolate_modules([{Mod,_Case,_Args}|Cases], Set) -> html_isolate_modules(Cases, sets:add_element(Mod, Set)). %% Given a list of modules, convert each module's source code to HTML. - html_convert_modules([Mod|Mods]) -> case code:which(Mod) of Path when is_list(Path) -> SrcFile = filename:rootname(Path) ++ ".erl", - DestDir = get(test_server_dir), - Name = atom_to_list(Mod), - DestFile = filename:join(DestDir, downcase(Name) ++ ?src_listing_ext), - html_possibly_convert(SrcFile, DestFile), - html_convert_modules(Mods); - _Other -> ok + FoundSrcFile = + case file:read_file_info(SrcFile) of + {ok,SInfo} -> + {SrcFile,SInfo}; + {error,_} -> + ModInfo = Mod:module_info(compile), + case proplists:get_value(source, ModInfo) of + undefined -> + undefined; + OtherSrcFile -> + case file:read_file_info(OtherSrcFile) of + {ok,SInfo} -> + {OtherSrcFile,SInfo}; + {error,_} -> + undefined + end + end + end, + case FoundSrcFile of + undefined -> + html_convert_modules(Mods); + {SrcFile1,SrcFileInfo} -> + DestDir = get(test_server_dir), + Name = atom_to_list(Mod), + DestFile = filename:join(DestDir, + downcase(Name)++?src_listing_ext), + html_possibly_convert(SrcFile1, SrcFileInfo, DestFile), + html_convert_modules(Mods) + end; + _Other -> + html_convert_modules(Mods) end; html_convert_modules([]) -> ok. %% Convert source code to HTML if possible and needed. - -html_possibly_convert(Src, Dest) -> - case file:read_file_info(Src) of - {ok,SInfo} -> - case file:read_file_info(Dest) of - {error,_Reason} -> % no dest file - erl2html2:convert(Src, Dest); - {ok,DInfo} when DInfo#file_info.mtime < SInfo#file_info.mtime -> - erl2html2:convert(Src, Dest); - {ok,_DInfo} -> ok % dest file up to date - end; - {error,_Reason} -> ok % no source code found +html_possibly_convert(Src, SrcInfo, Dest) -> + case file:read_file_info(Dest) of + {error,_Reason} -> % no dest file + erl2html2:convert(Src, Dest); + {ok,DestInfo} when DestInfo#file_info.mtime < SrcInfo#file_info.mtime -> + erl2html2:convert(Src, Dest); + {ok,_DestInfo} -> + ok % dest file up to date end. %% Copy all HTML files in InDir to OutDir. - copy_html_files(InDir, OutDir) -> Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)), lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files). diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 1a614d74d5..53dfb45e3a 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -83,13 +83,13 @@ timetrap(Timeout0, Scale, Pid) -> %% Handle = term() %% %% Cancels a time trap. - timetrap_cancel(Handle) -> unlink(Handle), MonRef = erlang:monitor(process, Handle), exit(Handle, kill), receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end. + capture_get(Msgs) -> receive {captured,Msg} -> diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 2ddffccf5b..8332ccfb40 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -22,6 +22,7 @@ -export([install/2, platform_id/1]). -include("ts.hrl"). +-include_lib("kernel/include/file.hrl"). install(install_local, Options) -> install(os:type(), Options); @@ -150,11 +151,17 @@ add_vars(Vars0, Opts0) -> end, {PlatformId, PlatformLabel, PlatformFilename, Version} = platform([{longnames, LongNames}|Vars0]), + NetDir = lists:concat(["/net", hostname()]), + Mounted = case file:read_file_info(NetDir) of + {ok, #file_info{type = directory}} -> NetDir; + _ -> "" + end, {Opts, [{longnames, LongNames}, {platform_id, PlatformId}, {platform_filename, PlatformFilename}, {rsh_name, get_rsh_name()}, {platform_label, PlatformLabel}, + {ts_net_dir, Mounted}, {erl_flags, []}, {erl_release, Version}, {ts_testcase_callback, get_testcase_callback()} | Vars0]}. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 067961a216..d145290820 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -212,6 +212,12 @@ make_command(Vars, Spec, State) -> false -> ok end, + + %% If Common Test specific variables are needed, add them here + %% on form: "{key1,value1}" "{key2,value2}" ... + NetDir = ts_lib:var(ts_net_dir, Vars), + TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ], + %% NOTE: Do not use ' in these commands as it wont work on windows Cmd = [Erl, Naming, "test_server" " -rsh ", ts_lib:var(rsh_name, Vars), @@ -224,6 +230,7 @@ make_command(Vars, Spec, State) -> %% " -test_server_format_exception false", " -boot start_sasl -sasl errlog_type error", " -pz ",Cwd, + " -ct_test_vars ",TestVars, " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " " -eval \"ct:run_test(", backslashify(lists:flatten(State#state.test_server_args)),")\"" @@ -369,7 +376,6 @@ make_common_test_args(Args0, Options, _Vars) -> end, ConfigFiles = [{config,[filename:join(ConfigPath,File) || File <- get_config_files()]}], - io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ ConfigFiles++Options]). diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index e1c0d31371..6728bef2a4 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -386,7 +386,8 @@ then no prototype is inserted. The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-arrow-criteria - '(erlang-next-lines-empty-p + '(erlang-stop-when-in-type-spec + erlang-next-lines-empty-p erlang-at-end-of-function-p) "*List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' @@ -4045,6 +4046,16 @@ This function is designed to be a member of a criteria list." nil))) +(defun erlang-stop-when-in-type-spec () + "Return `stop' when in a type spec line. + +This function is designed to be a member of a criteria list." + (save-excursion + (beginning-of-line) + (when (save-match-data (looking-at "-\\(spec\\|type\\)")) + 'stop))) + + (defun erlang-next-lines-empty-p () "Return non-nil if next lines are empty. diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 230f0e9428..73a736f0e8 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -253,6 +253,7 @@ compile_modules(Files,Options) -> {i, Dir} when is_list(Dir) -> true; {d, _Macro} -> true; {d, _Macro, _Value} -> true; + export_all -> true; _ -> false end end, @@ -625,7 +626,7 @@ main_process_loop(State) -> case get_beam_file(Module,BeamFile0,Compiled0) of {ok,BeamFile} -> {Reply,Compiled} = - case do_compile_beam(Module,BeamFile) of + case do_compile_beam(Module,BeamFile,[]) of {ok, Module} -> remote_load_compiled(State#main_state.nodes, [{Module,BeamFile}]), @@ -1258,13 +1259,13 @@ do_compile(File, UserOptions) -> Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions, case compile:file(File, Options) of {ok, Module, Binary} -> - do_compile_beam(Module,Binary); + do_compile_beam(Module,Binary,UserOptions); error -> error end. %% Beam is a binary or a .beam file name -do_compile_beam(Module,Beam) -> +do_compile_beam(Module,Beam,UserOptions) -> %% Clear database do_clear(Module), @@ -1284,7 +1285,7 @@ do_compile_beam(Module,Beam) -> %% Compile and load the result %% It's necessary to check the result of loading since it may %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, []), + {ok, Module, Binary} = compile:forms(Forms, UserOptions), case code:load_binary(Module, ?TAG, Binary) of {module, Module} -> diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 067fd31961..2748f21bbe 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -335,6 +335,12 @@ supervisor:start_child(Pid, [id1])</code> <c>apply(call, start_link, []++[id1])</c>, or actually:</p> <code type="none"> call:start_link(id1)</code> + <p>A child under a <c>simple_one_for_one</c> supervisor can be terminated + with</p> + <code type="none"> +supervisor:terminate_child(Sup, Pid)</code> + <p>where <c>Sup</c> is the pid, or name, of the supervisor and + <c>Pid</c> is the pid of the child.</p> </section> <section> |