aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--erts/emulator/beam/beam_emu.c11
-rw-r--r--erts/emulator/beam/beam_load.c19
-rw-r--r--erts/emulator/test/binary_SUITE.erl9
-rw-r--r--erts/emulator/test/match_spec_SUITE.erl30
-rw-r--r--erts/emulator/test/pseudoknot_SUITE.erl14
-rw-r--r--erts/emulator/test/scheduler_SUITE.erl67
-rw-r--r--erts/emulator/test/trace_call_time_SUITE.erl6
-rw-r--r--erts/emulator/test/trace_local_SUITE.erl5
-rw-r--r--erts/emulator/test/trace_meta_SUITE.erl7
-rw-r--r--erts/emulator/test/tuple_SUITE.erl4
-rw-r--r--lib/compiler/src/compile.erl101
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl37
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl4
-rw-r--r--lib/compiler/test/compilation_SUITE.erl10
-rw-r--r--lib/compiler/test/guard_SUITE.erl6
-rw-r--r--lib/compiler/test/inline_SUITE.erl4
-rw-r--r--lib/compiler/test/lc_SUITE.erl4
-rw-r--r--lib/compiler/test/test_lib.erl18
-rw-r--r--lib/erl_interface/src/decode/decode_atom.c2
-rw-r--r--lib/erl_interface/src/decode/decode_pid.c2
-rw-r--r--lib/erl_interface/src/decode/decode_port.c2
-rw-r--r--lib/erl_interface/src/decode/decode_ref.c3
-rw-r--r--lib/erl_interface/src/legacy/erl_connect.c7
-rw-r--r--lib/erl_interface/src/legacy/erl_format.c2
-rw-r--r--lib/erl_interface/src/legacy/erl_marshal.c4
-rw-r--r--lib/erl_interface/src/legacy/erl_timeout.c2
-rw-r--r--lib/erl_interface/src/misc/ei_decode_term.c5
-rw-r--r--lib/kernel/src/inet6_tcp_dist.erl6
-rw-r--r--lib/kernel/src/os.erl7
-rw-r--r--lib/kernel/test/erl_distribution_SUITE.erl4
-rw-r--r--lib/kernel/test/os_SUITE.erl17
-rw-r--r--lib/ssl/src/inet_ssl_dist.erl27
-rw-r--r--lib/ssl/src/ssl.erl4
-rw-r--r--lib/ssl/src/ssl_connection.erl6
-rw-r--r--lib/stdlib/src/supervisor.erl115
-rw-r--r--lib/stdlib/test/ets_SUITE.erl4
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl4
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl131
-rw-r--r--lib/test_server/test/Makefile7
-rw-r--r--lib/test_server/test/test_server.spec3
-rw-r--r--lib/test_server/test/test_server_SUITE.erl656
-rw-r--r--lib/test_server/test/test_server_SUITE_data/Makefile.src2
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl554
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file (renamed from lib/test_server/test/test_server_SUITE_data/dummy_file)0
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl (renamed from lib/test_server/test/test_server_conf01_SUITE.erl)0
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl (renamed from lib/test_server/test/test_server_conf02_SUITE.erl)0
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl (renamed from lib/test_server/test/test_server_parallel01_SUITE.erl)0
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl (renamed from lib/test_server/test/test_server_shuffle01_SUITE.erl)0
-rw-r--r--lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl (renamed from lib/test_server/test/test_server_skip_SUITE.erl)0
-rw-r--r--lib/test_server/test/test_server_line_SUITE.erl19
-rw-r--r--lib/test_server/test/test_server_test_lib.erl191
-rw-r--r--lib/test_server/test/test_server_test_lib.hrl23
52 files changed, 1302 insertions, 863 deletions
diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c
index 16741aa2d7..12a8022861 100644
--- a/erts/emulator/beam/beam_emu.c
+++ b/erts/emulator/beam/beam_emu.c
@@ -3424,7 +3424,6 @@ void process_main(void)
OpCase(case_end_r):
case_end_val = r(0);
- I--;
do_case_end:
c_p->fvalue = case_end_val;
@@ -5865,9 +5864,6 @@ build_stacktrace(Process* c_p, Eterm exc) {
Eterm args;
int depth;
BeamInstr* current;
-#if HALFWORD_HEAP
- BeamInstr current_buff[3];
-#endif
Eterm Where = NIL;
Eterm *next_p = &Where;
@@ -5897,14 +5893,7 @@ build_stacktrace(Process* c_p, Eterm exc) {
* (e.g. spawn_link(erlang, abs, [1])).
*/
if (current == NULL) {
-#if HALFWORD_HEAP
- current = current_buff;
- current[0] = (BeamInstr) c_p->initial[0];
- current[1] = (BeamInstr) c_p->initial[1];
- current[2] = (BeamInstr) c_p->initial[2];
-#else
current = c_p->initial;
-#endif
args = am_true; /* Just in case */
} else {
args = get_args_from_exc(exc);
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 4e0d19dafa..788cb4209c 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -3770,25 +3770,32 @@ freeze_code(LoaderState* stp)
CHKBLK(ERTS_ALC_T_CODE,code);
if (compile_size) {
byte* compile_info = str_table + strtab_size + attr_size;
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code);
sys_memcpy(compile_info, stp->chunks[COMPILE_CHUNK].start,
stp->chunks[COMPILE_CHUNK].size);
- CHKBLK(ERTS_ALC_T_CODE,code);
+
+ CHKBLK(ERTS_ALC_T_CODE,code);
code[MI_COMPILE_PTR] = (BeamInstr) compile_info;
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code);
code[MI_COMPILE_SIZE] = (BeamInstr) stp->chunks[COMPILE_CHUNK].size;
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code);
decoded_size = erts_decode_ext_size(compile_info, compile_size, 0);
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code);
if (decoded_size < 0) {
LoadError0(stp, "bad external term representation of compilation information");
}
- CHKBLK(ERTS_ALC_T_CODE,code);
+ CHKBLK(ERTS_ALC_T_CODE,code);
code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size;
}
CHKBLK(ERTS_ALC_T_CODE,code);
/*
+ * Make sure that we have not overflowed the allocated code space.
+ */
+ ASSERT(str_table + strtab_size + attr_size + compile_size ==
+ ((byte *) code) + size);
+
+ /*
* Go through all i_new_bs_put_strings instructions, restore the pointer to
* the instruction and convert string offsets to pointers (to the
* FIRST character).
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index 9b8905712e..7e409f053e 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -1321,11 +1321,4 @@ unaligned_sub_bin(Bin0, Offs) ->
<<_:Offs,Bin:Sz/binary,_:Roffs>> = id(Bin1),
Bin.
-hostname() ->
- from($@, atom_to_list(node())).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(_, []) -> [].
-
id(I) -> I.
diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl
index 6bddbb14f5..2b21fa58f4 100644
--- a/erts/emulator/test/match_spec_SUITE.erl
+++ b/erts/emulator/test/match_spec_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -30,7 +30,7 @@
-export([runner/2]).
-export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]).
--export([do_boxed_and_small/0, suite/0]).
+-export([do_boxed_and_small/0]).
% This test suite assumes that tracing in general works. What we test is
% the match spec functionality.
@@ -365,15 +365,15 @@ silent_no_ms(Config) when is_list(Config) ->
fun () ->
?MODULE:f1(a),
?MODULE:f2(b, c),
- erlang:integer_to_list(id(1)),
+ _ = erlang:integer_to_list(id(1)),
?MODULE:f3(d, e),
?MODULE:f1(start),
?MODULE:f2(f, g),
- erlang:integer_to_list(id(2)),
+ _ = erlang:integer_to_list(id(2)),
?MODULE:f3(h, i),
?MODULE:f1(stop),
?MODULE:f2(j, k),
- erlang:integer_to_list(id(3)),
+ _ = erlang:integer_to_list(id(3)),
?MODULE:f3(l, m)
end,
fun (Tracee) ->
@@ -413,15 +413,15 @@ silent_no_ms(Config) when is_list(Config) ->
fun () ->
?MODULE:f1(a),
?MODULE:f2(b, c),
- erlang:integer_to_list(id(1)),
+ _ = erlang:integer_to_list(id(1)),
?MODULE:f3(d, e),
?MODULE:f1(start),
?MODULE:f2(f, g),
- erlang:integer_to_list(id(2)),
+ _ = erlang:integer_to_list(id(2)),
?MODULE:f3(h, i),
?MODULE:f1(stop),
?MODULE:f2(j, k),
- erlang:integer_to_list(id(3)),
+ _ = erlang:integer_to_list(id(3)),
?MODULE:f3(l, m)
end,
fun (Tracee) ->
@@ -475,18 +475,18 @@ ms_trace2(Config) when is_list(Config) ->
fun () ->
?MODULE:f1(a),
?MODULE:f2(b, c),
- erlang:integer_to_list(id(1)),
+ _ = erlang:integer_to_list(id(1)),
?MODULE:f3(d, e),
fn([all], [call,return_to,{tracer,Tracer}]),
?MODULE:f1(f),
f2(g, h),
f1(i),
- erlang:integer_to_list(id(2)),
+ _ = erlang:integer_to_list(id(2)),
?MODULE:f3(j, k),
fn([call,return_to], []),
?MODULE:f1(l),
?MODULE:f2(m, n),
- erlang:integer_to_list(id(3)),
+ _ = erlang:integer_to_list(id(3)),
?MODULE:f3(o, p)
end,
fun (Tracee) ->
@@ -571,26 +571,26 @@ ms_trace3(Config) when is_list(Config) ->
register(TraceeName, self()),
?MODULE:f1(a),
?MODULE:f2(b, c),
- erlang:integer_to_list(id(1)),
+ _ = erlang:integer_to_list(id(1)),
?MODULE:f3(d, e),
Controller ! {self(),Tag,start},
receive {Controller,Tag,started} -> ok end,
?MODULE:f1(f),
f2(g, h),
f1(i),
- erlang:integer_to_list(id(2)),
+ _ = erlang:integer_to_list(id(2)),
?MODULE:f3(j, k),
Controller ! {self(),Tag,stop_1},
receive {Controller,Tag,stopped_1} -> ok end,
?MODULE:f1(l),
?MODULE:f2(m, n),
- erlang:integer_to_list(id(3)),
+ _ = erlang:integer_to_list(id(3)),
?MODULE:f3(o, p),
Controller ! {self(),Tag,stop_2},
receive {Controller,Tag,stopped_2} -> ok end,
?MODULE:f1(q),
?MODULE:f2(r, s),
- erlang:integer_to_list(id(4)),
+ _ = erlang:integer_to_list(id(4)),
?MODULE:f3(t, u)
end,
diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl
index f0668dd287..5a7cdcecd5 100644
--- a/erts/emulator/test/pseudoknot_SUITE.erl
+++ b/erts/emulator/test/pseudoknot_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -3294,13 +3294,13 @@ most_distant_atom(Sols) ->
maximum(map(sol_most_distant_atom, Sols)).
maximum([H|T]) ->
- max(T,H).
+ max1(T,H).
-max([H|T],M) when is_float(H), is_float(M), H > M ->
- max(T,H);
-max([_|T],M) ->
- max(T,M);
-max([],M) -> M.
+max1([H|T],M) when is_float(H), is_float(M), H > M ->
+ max1(T,H);
+max1([_|T],M) ->
+ max1(T,M);
+max1([],M) -> M.
map(_Func,[]) -> [];
map(Func,[H|T]) ->
diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl
index 1478bbeb52..f16d0ea429 100644
--- a/erts/emulator/test/scheduler_SUITE.erl
+++ b/erts/emulator/test/scheduler_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -862,9 +862,9 @@ get_affinity_mask(Port, Status, Affinity) when Status == unknown;
{Port,{exit_status,S}} ->
get_affinity_mask(Port, S, Affinity)
end;
-get_affinity_mask(Port, Status, bad) ->
+get_affinity_mask(_Port, _Status, bad) ->
unknown;
-get_affinity_mask(Port, Status, Affinity) ->
+get_affinity_mask(_Port, _Status, Affinity) ->
Affinity.
get_affinity_mask() ->
@@ -1389,67 +1389,6 @@ reader_groups_map(CPUT, Groups) ->
%% Utils
%%
-tilera_cpu_topology() ->
- [{processor,[{node,[{core,{logical,0}},
- {core,{logical,1}},
- {core,{logical,2}},
- {core,{logical,8}},
- {core,{logical,9}},
- {core,{logical,10}},
- {core,{logical,11}},
- {core,{logical,16}},
- {core,{logical,17}},
- {core,{logical,18}},
- {core,{logical,19}},
- {core,{logical,24}},
- {core,{logical,25}},
- {core,{logical,27}},
- {core,{logical,29}}]},
- {node,[{core,{logical,3}},
- {core,{logical,4}},
- {core,{logical,5}},
- {core,{logical,6}},
- {core,{logical,7}},
- {core,{logical,12}},
- {core,{logical,13}},
- {core,{logical,14}},
- {core,{logical,15}},
- {core,{logical,20}},
- {core,{logical,21}},
- {core,{logical,22}},
- {core,{logical,23}},
- {core,{logical,28}},
- {core,{logical,30}}]},
- {node,[{core,{logical,31}},
- {core,{logical,36}},
- {core,{logical,37}},
- {core,{logical,38}},
- {core,{logical,44}},
- {core,{logical,45}},
- {core,{logical,46}},
- {core,{logical,47}},
- {core,{logical,51}},
- {core,{logical,52}},
- {core,{logical,53}},
- {core,{logical,54}},
- {core,{logical,55}},
- {core,{logical,60}},
- {core,{logical,61}}]},
- {node,[{core,{logical,26}},
- {core,{logical,32}},
- {core,{logical,33}},
- {core,{logical,34}},
- {core,{logical,35}},
- {core,{logical,39}},
- {core,{logical,40}},
- {core,{logical,41}},
- {core,{logical,42}},
- {core,{logical,43}},
- {core,{logical,48}},
- {core,{logical,49}},
- {core,{logical,50}},
- {core,{logical,58}}]}]}].
-
l(Id) ->
{logical, Id}.
diff --git a/erts/emulator/test/trace_call_time_SUITE.erl b/erts/emulator/test/trace_call_time_SUITE.erl
index 8bf66b7177..5dfa87bbee 100644
--- a/erts/emulator/test/trace_call_time_SUITE.erl
+++ b/erts/emulator/test/trace_call_time_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010. All Rights Reserved.
+%% Copyright Ericsson AB 2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -427,7 +427,7 @@ nif(Config) when is_list(Config) ->
?line 1 = erlang:trace_pattern({?MODULE, nif_dec, '_'}, true, [call_time]),
?line 1 = erlang:trace_pattern({?MODULE, with_nif, '_'}, true, [call_time]),
?line Pid = setup(),
- ?line {L, T1} = execute(Pid, fun() -> with_nif(M) end),
+ ?line {_, T1} = execute(Pid, fun() -> with_nif(M) end),
% the nif is called M - 1 times, the last time the function with 'with_nif'
% returns ok and does not call the nif.
@@ -506,7 +506,7 @@ with_nif(N) ->
with_nif(?MODULE:nif_dec(N)).
-nif_dec(N) -> 0.
+nif_dec(_) -> 0.
dec(N) ->
loaded(10000),
diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl
index 0235f624ce..091e960610 100644
--- a/erts/emulator/test/trace_local_SUITE.erl
+++ b/erts/emulator/test/trace_local_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -814,9 +814,6 @@ loop(D1,D2,D3,0) ->
loop(D1,D2,D3,N) ->
max(N,loop(D1,D2,D3,N-1)).
-max(A, B) when A > B -> A;
-max(_, B) -> B.
-
exported_wrap(Val) ->
exported(Val).
diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl
index 666bd60511..45987cc319 100644
--- a/erts/emulator/test/trace_meta_SUITE.erl
+++ b/erts/emulator/test/trace_meta_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -613,11 +613,6 @@ loop(D1,D2,D3,0) ->
loop(D1,D2,D3,N) ->
max(N,loop(D1,D2,D3,N-1)).
-max(A,B) when A > B ->
- A;
-max(_A,B) ->
- B.
-
id(X) ->
X.
diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl
index c1f171d9b5..bfc3910742 100644
--- a/erts/emulator/test/tuple_SUITE.erl
+++ b/erts/emulator/test/tuple_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -99,7 +99,7 @@ t_tuple_size(Config) when is_list(Config) ->
ludicrous_tuple_size(T)
when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok;
-ludicrous_tuple_size(T) -> error.
+ludicrous_tuple_size(_) -> error.
%% Tests element/2.
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 38603a76a1..ce8a5bf864 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -112,9 +112,10 @@ noenv_forms(Forms, Opt) when is_atom(Opt) ->
-spec noenv_output_generated([option()]) -> boolean().
noenv_output_generated(Opts) ->
+ {_,Passes} = passes(file, expand_opts(Opts)),
any(fun ({save_binary,_F}) -> true;
(_Other) -> false
- end, passes(file, expand_opts(Opts))).
+ end, Passes).
%%
%% Local functions
@@ -243,26 +244,12 @@ internal(Master, Input, Opts) ->
end}.
internal({forms,Forms}, Opts) ->
- Ps = passes(forms, Opts),
+ {_,Ps} = passes(forms, Opts),
internal_comp(Ps, "", "", #compile{code=Forms,options=Opts});
internal({file,File}, Opts) ->
- Ps = passes(file, Opts),
+ {Ext,Ps} = passes(file, Opts),
Compile = #compile{options=Opts},
- case member(from_core, Opts) of
- true -> internal_comp(Ps, File, ".core", Compile);
- false ->
- case member(from_beam, Opts) of
- true ->
- internal_comp(Ps, File, ".beam", Compile);
- false ->
- case member(from_asm, Opts) orelse member(asm, Opts) of
- true ->
- internal_comp(Ps, File, ".S", Compile);
- false ->
- internal_comp(Ps, File, ".erl", Compile)
- end
- end
- end.
+ internal_comp(Ps, File, Ext, Compile).
internal_comp(Passes, File, Suffix, St0) ->
Dir = filename:dirname(File),
@@ -370,42 +357,52 @@ mpf(Ms) ->
[{File,[M || {F,M} <- Ms, F =:= File]} ||
File <- lists:usort([F || {F,_} <- Ms])].
-%% passes(forms|file, [Option]) -> [{Name,PassFun}]
-%% Figure out which passes that need to be run.
+%% passes(forms|file, [Option]) -> {Extension,[{Name,PassFun}]}
+%% Figure out the extension of the input file and which passes
+%% that need to be run.
-passes(forms, Opts) ->
- case member(from_core, Opts) of
- true ->
- select_passes(core_passes(), Opts);
- false ->
- select_passes(standard_passes(), Opts)
+passes(Type, Opts) ->
+ {Ext,Passes0} = passes_1(Opts),
+ Passes1 = case Type of
+ file -> Passes0;
+ forms -> tl(Passes0)
+ end,
+ Passes = select_passes(Passes1, Opts),
+
+ %% If the last pass saves the resulting binary to a file,
+ %% insert a first pass to remove the file (unless the
+ %% source file is a BEAM file).
+ {Ext,case last(Passes) of
+ {save_binary,_Fun} ->
+ case Passes of
+ [{read_beam_file,_}|_] ->
+ %% The BEAM is both input and output.
+ %% Don't remove it.
+ Passes;
+ _ ->
+ [?pass(remove_file)|Passes]
+ end;
+ _ ->
+ Passes
+ end}.
+
+passes_1([Opt|Opts]) ->
+ case pass(Opt) of
+ {_,_}=Res -> Res;
+ none -> passes_1(Opts)
end;
-passes(file, Opts) ->
- case member(from_beam, Opts) of
- true ->
- Ps = [?pass(read_beam_file)|binary_passes()],
- select_passes(Ps, Opts);
- false ->
- Ps = case member(from_asm, Opts) orelse member(asm, Opts) of
- true ->
- [?pass(beam_consult_asm)|asm_passes()];
- false ->
- case member(from_core, Opts) of
- true ->
- [?pass(parse_core)|core_passes()];
- false ->
- [?pass(parse_module)|standard_passes()]
- end
- end,
- Fs = select_passes(Ps, Opts),
-
- %% If the last pass saves the resulting binary to a file,
- %% insert a first pass to remove the file.
- case last(Fs) of
- {save_binary,_Fun} -> [?pass(remove_file)|Fs];
- _Other -> Fs
- end
- end.
+passes_1([]) ->
+ {".erl",[?pass(parse_module)|standard_passes()]}.
+
+pass(from_core) ->
+ {".core",[?pass(parse_core)|core_passes()]};
+pass(from_asm) ->
+ {".S",[?pass(beam_consult_asm)|asm_passes()]};
+pass(asm) ->
+ pass(from_asm);
+pass(from_beam) ->
+ {".beam",[?pass(read_beam_file)|binary_passes()]};
+pass(_) -> none.
%% select_passes([Command], Opts) -> [{Name,Function}]
%% Interpret the lists of commands to return a pure list of passes.
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index 9bd13f7032..e363a5387a 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -20,10 +20,12 @@
-module(v3_kernel_pp).
--include("v3_kernel.hrl").
-
-export([format/1]).
+%%-define(INCLUDE_ANNOTATIONS, 1).
+
+-include("v3_kernel.hrl").
+
%% These are "internal" structures in sys_kernel which are here for
%% debugging purposes.
-record(iset, {anno=[],vars,arg,body}).
@@ -62,22 +64,21 @@ format(Node, Ctxt) ->
end)
end.
-format_anno(Anno, Ctxt0, ObjFun) ->
- case annotations_enabled() of
- true ->
- Ctxt1 = ctxt_bump_indent(Ctxt0, 1),
- ["( ",
- ObjFun(Ctxt0),
- nl_indent(Ctxt1),
- "-| ",io_lib:write(Anno),
- " )"];
- false ->
- ObjFun(Ctxt0)
- end.
-%% By default, don't show annotations since they clutter up the output.
-annotations_enabled() ->
- false.
+-ifndef(INCLUDE_ANNOTATIONS).
+%% Don't include annotations (for readability).
+format_anno(_Anno, Ctxt, ObjFun) ->
+ ObjFun(Ctxt).
+-else.
+%% Include annotations (for debugging of annotations).
+format_anno(Anno, Ctxt0, ObjFun) ->
+ Ctxt1 = ctxt_bump_indent(Ctxt0, 1),
+ ["( ",
+ ObjFun(Ctxt0),
+ nl_indent(Ctxt1),
+ "-| ",io_lib:write(Anno),
+ " )"].
+-endif.
%% format_1(Kexpr, Context) -> string().
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index fe72fbb143..c430b12b70 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -231,7 +231,7 @@ one_test({C_bin, E_bin, Str, Result}) ->
ok;
%% For situations where the final bits may not matter, like
%% for floats:
- N when integer(N) ->
+ N when is_integer(N) ->
io:format("Info: compiled and interpreted differ in the"
" last bytes:~n ~p, ~p.~n",
[bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index 6cd133ee39..ba225b66d0 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -163,7 +163,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) ->
beam_compiler_7(doc) ->
"Code snippet submitted from Ulf Wiger which fails in R3 Beam.";
beam_compiler_7(suite) -> [];
-beam_compiler_7(Config) when list(Config) ->
+beam_compiler_7(Config) when is_list(Config) ->
?line done = empty(2, false).
empty(N, Toggle) when N > 0 ->
@@ -327,7 +327,7 @@ from(_, []) -> [].
vsn_1(doc) ->
"Test generation of 'vsn' attribute";
vsn_1(suite) -> [];
-vsn_1(Conf) when list(Conf) ->
+vsn_1(Conf) when is_list(Conf) ->
?line M = vsn_1,
?line compile_load(M, ?config(data_dir, Conf), Conf),
@@ -351,7 +351,7 @@ vsn_1(Conf) when list(Conf) ->
vsn_2(doc) ->
"Test overriding of generation of 'vsn' attribute";
vsn_2(suite) -> [];
-vsn_2(Conf) when list(Conf) ->
+vsn_2(Conf) when is_list(Conf) ->
?line M = vsn_2,
?line compile_load(M, ?config(data_dir, Conf), Conf),
@@ -367,7 +367,7 @@ vsn_2(Conf) when list(Conf) ->
vsn_3(doc) ->
"Test that different code yields different generated 'vsn'";
vsn_3(suite) -> [];
-vsn_3(Conf) when list(Conf) ->
+vsn_3(Conf) when is_list(Conf) ->
?line M = vsn_3,
?line compile_load(M, ?config(data_dir, Conf), Conf),
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 7201edf4ac..482564a32b 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -111,8 +111,8 @@ const_cond(Config) when is_list(Config) ->
const_cond(T, Sz) ->
case T of
_X when false -> never;
- _X when tuple(T), eq == eq, tuple_size(T) == Sz -> ok;
- _X when tuple(T), eq == leq, tuple_size(T) =< Sz -> ok;
+ _X when is_tuple(T), eq == eq, tuple_size(T) == Sz -> ok;
+ _X when is_tuple(T), eq == leq, tuple_size(T) =< Sz -> ok;
_X -> error
end.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 6684b82751..7b9600c2f6 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -68,7 +68,7 @@ attribute(Config) when is_list(Config) ->
ok.
-define(comp(Name),
- Name(Config) when list(Config) ->
+ Name(Config) when is_list(Config) ->
try_inline(Name, Config)).
?comp(bsdecode).
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 6dd950eade..bcdcf2fd9f 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -180,7 +180,7 @@ empty_generator(Config) when is_list(Config) ->
id(I) -> I.
fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok;
-fc(Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}})
+fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}})
when length(Args) =:= Arity ->
true = test_server:is_native(?MODULE);
fc(Args, {'EXIT',{{case_clause,ActualArgs},_}})
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index d8799952a9..53d8c04169 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -41,7 +41,7 @@ smoke_disasm(Mod) when is_atom(Mod) ->
smoke_disasm(code:which(Mod));
smoke_disasm(File) when is_list(File) ->
Res = beam_disasm:file(File),
- {beam_file,Mod} = {element(1, Res),element(2, Res)}.
+ {beam_file,_Mod} = {element(1, Res),element(2, Res)}.
%% Retrieve the "interesting" compiler options (options for optimization
%% and compatibility) for the given module.
@@ -62,16 +62,16 @@ opt_opts(Mod) ->
(_) -> false
end, Opts).
-%% Some test suites gets cloned (e.g. to "record_SUITE" to "record_no_opt_SUITE"),
-%% but the data directory is not cloned. This function retrieves the path to
-%% the original data directory.
+%% Some test suites gets cloned (e.g. to "record_SUITE" to
+%% "record_no_opt_SUITE"), but the data directory is not cloned.
+%% This function retrieves the path to the original data directory.
get_data_dir(Config) ->
Data0 = ?config(data_dir, Config),
- {ok,Data1,_} = regexp:sub(Data0, "_no_opt_SUITE", "_SUITE"),
- {ok,Data2,_} = regexp:sub(Data1, "_post_opt_SUITE", "_SUITE"),
- {ok,Data,_} = regexp:sub(Data2, "_inline_SUITE", "_SUITE"),
- Data.
+ Opts = [{return,list}],
+ Data1 = re:replace(Data0, "_no_opt_SUITE", "_SUITE", Opts),
+ Data = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts),
+ re:replace(Data, "_inline_SUITE", "_SUITE", Opts).
%% p_run(fun(Data) -> ok|error, List) -> ok
%% Will fail the test case if there were any errors.
diff --git a/lib/erl_interface/src/decode/decode_atom.c b/lib/erl_interface/src/decode/decode_atom.c
index b247bd4e17..ef28838b79 100644
--- a/lib/erl_interface/src/decode/decode_atom.c
+++ b/lib/erl_interface/src/decode/decode_atom.c
@@ -31,6 +31,8 @@ int ei_decode_atom(const char *buf, int *index, char *p)
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
+
if (p) {
memmove(p,s,len);
p[len] = (char)0;
diff --git a/lib/erl_interface/src/decode/decode_pid.c b/lib/erl_interface/src/decode/decode_pid.c
index 5f2aec3b44..48a0c68240 100644
--- a/lib/erl_interface/src/decode/decode_pid.c
+++ b/lib/erl_interface/src/decode/decode_pid.c
@@ -33,6 +33,8 @@ int ei_decode_pid(const char *buf, int *index, erlang_pid *p)
if (get8(s) != ERL_ATOM_EXT) return -1;
len = get16be(s);
+
+ if (len > MAXATOMLEN) return -1;
if (p) {
memmove(p->node, s, len);
diff --git a/lib/erl_interface/src/decode/decode_port.c b/lib/erl_interface/src/decode/decode_port.c
index 7fb7d8d414..296ebae024 100644
--- a/lib/erl_interface/src/decode/decode_port.c
+++ b/lib/erl_interface/src/decode/decode_port.c
@@ -34,6 +34,8 @@ int ei_decode_port(const char *buf, int *index, erlang_port *p)
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
+
if (p) {
memmove(p->node, s, len);
p->node[len] = (char)0;
diff --git a/lib/erl_interface/src/decode/decode_ref.c b/lib/erl_interface/src/decode/decode_ref.c
index 6fc2cd6533..691b51fe2d 100644
--- a/lib/erl_interface/src/decode/decode_ref.c
+++ b/lib/erl_interface/src/decode/decode_ref.c
@@ -35,6 +35,8 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p)
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
+
if (p) {
memmove(p->node, s, len);
p->node[len] = (char)0;
@@ -62,6 +64,7 @@ int ei_decode_ref(const char *buf, int *index, erlang_ref *p)
/* then the nodename */
if (get8(s) != ERL_ATOM_EXT) return -1;
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
if (p) {
memmove(p->node, s, len);
diff --git a/lib/erl_interface/src/legacy/erl_connect.c b/lib/erl_interface/src/legacy/erl_connect.c
index 3c8c946506..e77bd5db37 100644
--- a/lib/erl_interface/src/legacy/erl_connect.c
+++ b/lib/erl_interface/src/legacy/erl_connect.c
@@ -180,9 +180,7 @@ int erl_xconnect(Erl_IpAddr addr, char *alivename)
*
* Close a connection. FIXME call ei_close_connection() later.
*
- * Returns valid file descriptor on success and < 0 on failure.
- * Set erl_errno to EHOSTUNREACH, ENOMEM, EIO or errno from socket(2)
- * or connect(2).
+ * Returns 0 on success and -1 on failure.
*
***************************************************************************/
@@ -250,7 +248,8 @@ int erl_send(int fd, ETERM *to ,ETERM *msg)
return -1;
}
- strcpy(topid.node, (char *)ERL_PID_NODE(to));
+ strncpy(topid.node, (char *)ERL_PID_NODE(to), sizeof(topid.node));
+ topid.node[sizeof(topid.node)-1] = '\0';
topid.num = ERL_PID_NUMBER(to);
topid.serial = ERL_PID_SERIAL(to);
topid.creation = ERL_PID_CREATION(to);
diff --git a/lib/erl_interface/src/legacy/erl_format.c b/lib/erl_interface/src/legacy/erl_format.c
index 9848e9296a..b17269213f 100644
--- a/lib/erl_interface/src/legacy/erl_format.c
+++ b/lib/erl_interface/src/legacy/erl_format.c
@@ -116,7 +116,7 @@ static lvar *lvar_alloc(void)
lvar *tmp;
if ((tmp = ef.idle) == NULL) {
- tmp = (lvar *) malloc(sizeof(lvar)); /* FIXME check result */
+ tmp = (lvar *) erl_malloc(sizeof(lvar));
}
else {
tmp = ef.idle;
diff --git a/lib/erl_interface/src/legacy/erl_marshal.c b/lib/erl_interface/src/legacy/erl_marshal.c
index 70949a7adf..5cfb5e2124 100644
--- a/lib/erl_interface/src/legacy/erl_marshal.c
+++ b/lib/erl_interface/src/legacy/erl_marshal.c
@@ -662,7 +662,7 @@ len = i
#define STATIC_NODE_BUF_SZ 30
#define SET_NODE(node,node_buf,cp,len) \
-if (len >= STATIC_NODE_BUF_SZ) node = malloc(len+1); \
+if (len >= STATIC_NODE_BUF_SZ) node = erl_malloc(len+1); \
else node = node_buf; \
memcpy(node, cp, len); \
node[len] = '\0'
@@ -1534,7 +1534,7 @@ static int cmp_string_list(unsigned char **e1, unsigned char **e2) {
if ( e1_len < 256 ) {
bp = buf;
} else {
- bp = malloc(5+(2*e1_len)+1);
+ bp = erl_malloc(5+(2*e1_len)+1);
}
bp[0] = ERL_LIST_EXT;
diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c
index af1a4a1f3a..6ef5d258ed 100644
--- a/lib/erl_interface/src/legacy/erl_timeout.c
+++ b/lib/erl_interface/src/legacy/erl_timeout.c
@@ -74,7 +74,7 @@ jmp_buf *timeout_setup(int ms)
t.it_value.tv_usec = (ms % 1000) * 1000;
/* get a jump buffer and save it */
- j = malloc(sizeof(*j)); /* FIXME check result */
+ j = erl_malloc(sizeof(*j));
j->siginfo = s;
push(j);
diff --git a/lib/erl_interface/src/misc/ei_decode_term.c b/lib/erl_interface/src/misc/ei_decode_term.c
index 75c5dc9460..9b238c1e90 100644
--- a/lib/erl_interface/src/misc/ei_decode_term.c
+++ b/lib/erl_interface/src/misc/ei_decode_term.c
@@ -49,6 +49,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term)
return ei_decode_double(buf, index, &term->value.d_val);
case ERL_ATOM_EXT:
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
memcpy(term->value.atom_name, s, len);
term->value.atom_name[len] = '\0';
s += len;
@@ -57,6 +58,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term)
/* first the nodename */
if (get8(s) != ERL_ATOM_EXT) return -1;
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
memcpy(term->value.ref.node, s, len);
term->value.ref.node[len] = '\0';
s += len;
@@ -71,6 +73,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term)
/* then the nodename */
if (get8(s) != ERL_ATOM_EXT) return -1;
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
memcpy(term->value.ref.node, s, len);
term->value.ref.node[len] = '\0';
s += len;
@@ -87,6 +90,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term)
case ERL_PORT_EXT:
if (get8(s) != ERL_ATOM_EXT) return -1;
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
memcpy(term->value.port.node, s, len);
term->value.port.node[len] = '\0';
term->value.port.id = get32be(s) & 0x0fffffff; /* 28 bits */;
@@ -96,6 +100,7 @@ int ei_decode_ei_term(const char* buf, int* index, ei_term* term)
if (get8(s) != ERL_ATOM_EXT) return -1;
/* name first */
len = get16be(s);
+ if (len > MAXATOMLEN) return -1;
memcpy(term->value.pid.node, s, len);
term->value.pid.node[len] = '\0';
s += len;
diff --git a/lib/kernel/src/inet6_tcp_dist.erl b/lib/kernel/src/inet6_tcp_dist.erl
index fab00bbb9f..b9c4fa607c 100644
--- a/lib/kernel/src/inet6_tcp_dist.erl
+++ b/lib/kernel/src/inet6_tcp_dist.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -162,8 +162,8 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
inet:getll(S)
end,
f_address = fun get_remote_id/2,
- mf_tick = {?MODULE, tick},
- mf_getstat = {?MODULE,getstat}
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1
},
dist_util:handshake_other_started(HSData);
{false,IP} ->
diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl
index 75a11a8afd..ce8c581e08 100644
--- a/lib/kernel/src/os.erl
+++ b/lib/kernel/src/os.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -82,8 +82,9 @@ verify_executable(Name0, [Ext|Rest], OrigExtensions) ->
end;
_ ->
case file:read_file_info(Name1) of
- {ok, #file_info{mode=Mode}} when Mode band 8#111 =/= 0 ->
- %% XXX This test for execution permission is not full-proof
+ {ok, #file_info{type=regular,mode=Mode}}
+ when Mode band 8#111 =/= 0 ->
+ %% XXX This test for execution permission is not fool-proof
%% on Unix, since we test if any execution bit is set.
{ok, Name1};
_ ->
diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl
index efce5bd476..9cccdab76b 100644
--- a/lib/kernel/test/erl_distribution_SUITE.erl
+++ b/lib/kernel/test/erl_distribution_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -865,7 +865,7 @@ monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) ->
% the node mercilessly.
% We then want to ensure that the nodedown message arrives
% last ... without garbage after it.
- Pid = spawn(fun() -> node_loop_send(Me, NodeMsg, 1) end),
+ _ = spawn(fun() -> node_loop_send(Me, NodeMsg, 1) end),
receive {Me, kill_it} -> ok end,
halt()
end),
diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl
index ecb9a111f6..b08b12c978 100644
--- a/lib/kernel/test/os_SUITE.erl
+++ b/lib/kernel/test/os_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -175,6 +175,21 @@ find_executable(Config) when is_list(Config) ->
?line find_exe(Current, "my_batch", ".bat", Path),
ok;
{unix, _} ->
+ DataDir = ?config(data_dir, Config),
+
+ %% Smoke test.
+ case lib:progname() of
+ erl ->
+ ?line ErlPath = os:find_executable("erl"),
+ ?line true = is_list(ErlPath),
+ ?line true = filelib:is_regular(ErlPath);
+ _ ->
+ %% Don't bother -- the progname could include options.
+ ok
+ end,
+
+ %% Never return a directory name.
+ ?line false = os:find_executable("unix", [DataDir]),
ok;
vxworks ->
ok
diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl
index b10aa76246..6c0fbc0618 100644
--- a/lib/ssl/src/inet_ssl_dist.erl
+++ b/lib/ssl/src/inet_ssl_dist.erl
@@ -1,8 +1,8 @@
-%%<copyright>
-%% <year>2000-2008</year>
-%% <holder>Ericsson AB, All Rights Reserved</holder>
-%%</copyright>
-%%<legalnotice>
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
@@ -14,8 +14,9 @@
%% the License for the specific language governing rights and limitations
%% under the License.
%%
-%% The Initial Developer of the Original Code is Ericsson AB.
-%%</legalnotice>
+%% %CopyrightEnd%
+%%
+
%%
-module(inet_ssl_dist).
@@ -137,7 +138,7 @@ accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
%% Suppress dialyzer warning, we do not really care about old ssl code
%% as we intend to remove it.
--spec(do_accept/6 :: (_,_,_,_,_,_) -> no_return()).
+-spec(do_accept(_,_,_,_,_,_) -> no_return()).
do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
process_flag(priority, max),
receive
@@ -170,8 +171,8 @@ do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) ->
ssl_prim:getll(S)
end,
f_address = fun get_remote_id/2,
- mf_tick = {?MODULE, tick},
- mf_getstat = {?MODULE,getstat}
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1
},
dist_util:handshake_other_started(HSData);
{false,IP} ->
@@ -209,7 +210,7 @@ setup(Node, Type, MyNode, LongOrShortNames,SetupTime) ->
%% Suppress dialyzer warning, we do not really care about old ssl code
%% as we intend to remove it.
--spec(do_setup/6 :: (_,_,_,_,_,_) -> no_return()).
+-spec(do_setup(_,_,_,_,_,_) -> no_return()).
do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
process_flag(priority, max),
?trace("~p~n",[{inet_ssl_dist,self(),setup,Node}]),
@@ -264,8 +265,8 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames,SetupTime) ->
protocol = ssl,
family = inet}
end,
- mf_tick = {?MODULE, tick},
- mf_getstat = {?MODULE,getstat},
+ mf_tick = fun ?MODULE:tick/1,
+ mf_getstat = fun ?MODULE:getstat/1,
request_type = Type
},
dist_util:handshake_we_started(HSData);
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 65b081937f..b85188b878 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -72,8 +72,8 @@
%%--------------------------------------------------------------------
--spec start() -> ok.
--spec start(permanent | transient | temporary) -> ok.
+-spec start() -> ok | {error, reason()}.
+-spec start(permanent | transient | temporary) -> ok | {error, reason()}.
%%
%% Description: Utility function that starts the ssl,
%% crypto and public_key applications. Default type
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 489895cf29..85245f4342 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -1086,13 +1086,13 @@ init_private_key({rsa, PrivateKey}, _, _,_) ->
init_private_key({dsa, PrivateKey},_,_,_) ->
public_key:der_decode('DSAPrivateKey', PrivateKey).
--spec(handle_file_error/6 :: (_,_,_,_,_,_) -> no_return()).
+-spec(handle_file_error(_,_,_,_,_,_) -> no_return()).
handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) ->
file_error(Line, Error, Reason, File, Throw, Stack);
handle_file_error(Line, Error, Reason, File, Throw, Stack) ->
file_error(Line, Error, Reason, File, Throw, Stack).
--spec(file_error/6 :: (_,_,_,_,_,_) -> no_return()).
+-spec(file_error(_,_,_,_,_,_) -> no_return()).
file_error(Line, Error, Reason, File, Throw, Stack) ->
Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n",
[Line, Error, Reason, File, Stack]),
@@ -1412,8 +1412,6 @@ key_exchange(#state{role = client,
State#state{connection_states = ConnectionStates1,
tls_handshake_hashes = Hashes1}.
--spec(rsa_key_exchange/2 :: (_,_) -> no_return()).
-
rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _})
when Algorithm == ?rsaEncryption;
Algorithm == ?md2WithRSAEncryption;
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index 7102fb9f6e..3c5800effa 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -40,7 +40,7 @@
%%--------------------------------------------------------------------------
-type child_id() :: pid() | 'undefined'.
--type mfargs() :: {module(), atom(), [term()]}.
+-type mfargs() :: {module(), atom(), [term()] | undefined}.
-type modules() :: [module()] | 'dynamic'.
-type restart() :: 'permanent' | 'transient' | 'temporary'.
-type shutdown() :: 'brutal_kill' | timeout().
@@ -69,7 +69,7 @@
-record(state, {name,
strategy :: strategy(),
children = [] :: [child()],
- dynamics = ?DICT:new() :: ?DICT(),
+ dynamics :: ?DICT() | list(),
intensity :: non_neg_integer(),
period :: pos_integer(),
restarts = [],
@@ -283,16 +283,15 @@ do_start_child_i(M, F, A) ->
-spec handle_call(call(), term(), state()) -> {'reply', term(), state()}.
handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) ->
- #child{mfargs = {M, F, A}} = hd(State#state.children),
+ Child = hd(State#state.children),
+ #child{mfargs = {M, F, A}} = Child,
Args = A ++ EArgs,
case do_start_child_i(M, F, Args) of
{ok, Pid} ->
- NState = State#state{dynamics =
- ?DICT:store(Pid, Args, State#state.dynamics)},
+ NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
{reply, {ok, Pid}, NState};
{ok, Pid, Extra} ->
- NState = State#state{dynamics =
- ?DICT:store(Pid, Args, State#state.dynamics)},
+ NState = save_dynamic_child(Child#child.restart_type, Pid, Args, State),
{reply, {ok, Pid, Extra}, NState};
What ->
{reply, What, State}
@@ -351,10 +350,20 @@ handle_call({terminate_child, Name}, _From, State) ->
{reply, {error, not_found}, State}
end;
-handle_call(which_children, _From, State) when ?is_simple(State) ->
- [#child{child_type = CT, modules = Mods}] = State#state.children,
+handle_call(which_children, _From, #state{children = [#child{restart_type = temporary,
+ child_type = CT,
+ modules = Mods}]} =
+ State) when ?is_simple(State) ->
+ Reply = lists:map(fun(Pid) -> {undefined, Pid, CT, Mods} end, dynamics_db(temporary,
+ State#state.dynamics)),
+ {reply, Reply, State};
+
+handle_call(which_children, _From, #state{children = [#child{restart_type = RType,
+ child_type = CT,
+ modules = Mods}]} =
+ State) when ?is_simple(State) ->
Reply = lists:map(fun({Pid, _}) -> {undefined, Pid, CT, Mods} end,
- ?DICT:to_list(State#state.dynamics)),
+ ?DICT:to_list(dynamics_db(RType, State#state.dynamics))),
{reply, Reply, State};
handle_call(which_children, _From, State) ->
@@ -366,13 +375,31 @@ handle_call(which_children, _From, State) ->
State#state.children),
{reply, Resp, State};
-handle_call(count_children, _From, State) when ?is_simple(State) ->
- [#child{child_type = CT}] = State#state.children,
+
+handle_call(count_children, _From, #state{children = [#child{restart_type = temporary,
+ child_type = CT}]} = State)
+ when ?is_simple(State) ->
+ {Active, Count} =
+ lists:foldl(fun(Pid, {Alive, Tot}) ->
+ if is_pid(Pid) -> {Alive+1, Tot +1};
+ true -> {Alive, Tot + 1} end
+ end, {0, 0}, dynamics_db(temporary, State#state.dynamics)),
+ Reply = case CT of
+ supervisor -> [{specs, 1}, {active, Active},
+ {supervisors, Count}, {workers, 0}];
+ worker -> [{specs, 1}, {active, Active},
+ {supervisors, 0}, {workers, Count}]
+ end,
+ {reply, Reply, State};
+
+handle_call(count_children, _From, #state{children = [#child{restart_type = RType,
+ child_type = CT}]} = State)
+ when ?is_simple(State) ->
{Active, Count} =
?DICT:fold(fun(Pid, _Val, {Alive, Tot}) ->
if is_pid(Pid) -> {Alive+1, Tot +1};
true -> {Alive, Tot + 1} end
- end, {0, 0}, State#state.dynamics),
+ end, {0, 0}, dynamics_db(RType, State#state.dynamics)),
Reply = case CT of
supervisor -> [{specs, 1}, {active, Active},
{supervisors, Count}, {workers, 0}];
@@ -535,15 +562,11 @@ handle_start_child(Child, State) ->
false ->
case do_start_child(State#state.name, Child) of
{ok, Pid} ->
- Children = State#state.children,
{{ok, Pid},
- State#state{children =
- [Child#child{pid = Pid}|Children]}};
+ save_child(Child#child{pid = Pid}, State)};
{ok, Pid, Extra} ->
- Children = State#state.children,
{{ok, Pid, Extra},
- State#state{children =
- [Child#child{pid = Pid}|Children]}};
+ save_child(Child#child{pid = Pid}, State)};
{error, What} ->
{{error, {What, Child}}, State}
end;
@@ -558,22 +581,21 @@ handle_start_child(Child, State) ->
%%% Returns: {ok, state()} | {shutdown, state()}
%%% ---------------------------------------------------
-restart_child(Pid, Reason, State) when ?is_simple(State) ->
- case ?DICT:find(Pid, State#state.dynamics) of
+restart_child(Pid, Reason, #state{children = [Child]} = State) when ?is_simple(State) ->
+ RestartType = Child#child.restart_type,
+ case dynamic_child_args(Pid, dynamics_db(RestartType, State#state.dynamics)) of
{ok, Args} ->
- [Child] = State#state.children,
- RestartType = Child#child.restart_type,
{M, F, _} = Child#child.mfargs,
NChild = Child#child{pid = Pid, mfargs = {M, F, Args}},
do_restart(RestartType, Reason, NChild, State);
error ->
- {ok, State}
+ {ok, State}
end;
+
restart_child(Pid, Reason, State) ->
Children = State#state.children,
case lists:keyfind(Pid, #child.pid, Children) of
- #child{} = Child ->
- RestartType = Child#child.restart_type,
+ #child{restart_type = RestartType} = Child ->
do_restart(RestartType, Reason, Child, State);
false ->
{ok, State}
@@ -608,7 +630,8 @@ restart(Child, State) ->
restart(simple_one_for_one, Child, State) ->
#child{mfargs = {M, F, A}} = Child,
- Dynamics = ?DICT:erase(Child#child.pid, State#state.dynamics),
+ Dynamics = ?DICT:erase(Child#child.pid, dynamics_db(Child#child.restart_type,
+ State#state.dynamics)),
case do_start_child_i(M, F, A) of
{ok, Pid} ->
NState = State#state{dynamics = ?DICT:store(Pid, A, Dynamics)},
@@ -755,8 +778,40 @@ monitor_child(Pid) ->
%%-----------------------------------------------------------------
%% Child/State manipulating functions.
%%-----------------------------------------------------------------
-state_del_child(#child{pid = Pid}, State) when ?is_simple(State) ->
- NDynamics = ?DICT:erase(Pid, State#state.dynamics),
+
+%% Note we do not want to save the parameter list for temporary processes as
+%% they will not be restarted, and hence we do not need this information.
+%% Especially for dynamic children to simple_one_for_one supervisors
+%% it could become very costly as it is not uncommon to spawn
+%% very many such processes.
+save_child(#child{restart_type = temporary,
+ mfargs = {M, F, _}} = Child, #state{children = Children} = State) ->
+ State#state{children = [Child#child{mfargs = {M, F, undefined}} |Children]};
+save_child(Child, #state{children = Children} = State) ->
+ State#state{children = [Child |Children]}.
+
+save_dynamic_child(temporary, Pid, _, #state{dynamics = Dynamics} = State) ->
+ State#state{dynamics = [Pid | dynamics_db(temporary, Dynamics)]};
+save_dynamic_child(RestartType, Pid, Args, #state{dynamics = Dynamics} = State) ->
+ State#state{dynamics = ?DICT:store(Pid, Args, dynamics_db(RestartType, Dynamics))}.
+
+dynamics_db(temporary, undefined) ->
+ [];
+dynamics_db(_, undefined) ->
+ ?DICT:new();
+dynamics_db(_,Dynamics) ->
+ Dynamics.
+
+dynamic_child_args(_, Dynamics) when is_list(Dynamics)->
+ {ok, undefined};
+dynamic_child_args(Pid, Dynamics) ->
+ ?DICT:find(Pid, Dynamics).
+
+state_del_child(#child{pid = Pid, restart_type = temporary}, State) when ?is_simple(State) ->
+ NDynamics = lists:delete(Pid, dynamics_db(temporary, State#state.dynamics)),
+ State#state{dynamics = NDynamics};
+state_del_child(#child{pid = Pid, restart_type = RType}, State) when ?is_simple(State) ->
+ NDynamics = ?DICT:erase(Pid, dynamics_db(RType, State#state.dynamics)),
State#state{dynamics = NDynamics};
state_del_child(Child, State) ->
NChildren = del_child(Child#child.name, State#state.children),
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 60fa429a3e..9d348b5f1a 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -348,8 +348,8 @@ t_match_spec_run_test(List, MS, Result) ->
ms_tracer_collect(Tracee, Ref, Acc) ->
receive
- {trace, Tracee, call, Args, [Msg]} ->
- %io:format("trace Args=~p Msg=~p\n", [Args, Msg]),
+ {trace, Tracee, call, _Args, [Msg]} ->
+ %io:format("trace Args=~p Msg=~p\n", [_Args, Msg]),
ms_tracer_collect(Tracee, Ref, [Msg | Acc]);
{'DOWN', Ref, process, Tracee, _} ->
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index f46493a2d8..0cca030b3d 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -75,7 +75,7 @@ app_test(suite) ->
[];
app_test(doc) ->
["Application consistency test."];
-app_test(Config) when list(Config) ->
+app_test(Config) when is_list(Config) ->
?t:app_test(stdlib),
ok.
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index 82643e105f..8aed93ce12 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -52,10 +52,12 @@
simple_one_for_one_extra/1]).
%% Misc tests
--export([child_unlink/1, tree/1, count_children_memory/1]).
+-export([child_unlink/1, tree/1, count_children_memory/1,
+ do_not_save_start_parameters_for_temporary_children/1]).
%-------------------------------------------------------------------------
+
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
@@ -67,7 +69,7 @@ all() ->
{group, restart_rest_for_one},
{group, normal_termination},
{group, abnormal_termination}, child_unlink, tree,
- count_children_memory].
+ count_children_memory, do_not_save_start_parameters_for_temporary_children].
groups() ->
[{sup_start, [],
@@ -117,7 +119,6 @@ init_per_testcase(_Case, Config) ->
end_per_testcase(_Case, _Config) ->
ok.
-
start(InitResult) ->
supervisor:start_link({local, sup_test}, ?MODULE, InitResult).
@@ -135,14 +136,8 @@ get_child_counts(Supervisor) ->
proplists:get_value(supervisors, Counts),
proplists:get_value(workers, Counts)].
-
%-------------------------------------------------------------------------
-%
% Test cases starts here.
-%
-%-------------------------------------------------------------------------
-
-
%-------------------------------------------------------------------------
sup_start_normal(doc) ->
["Tests that the supervisor process starts correctly and that it "
@@ -242,8 +237,6 @@ sup_start_fail(Config) when is_list(Config) ->
ok.
%-------------------------------------------------------------------------
-%-------------------------------------------------------------------------
-
sup_stop_infinity(doc) ->
["See sup_stop/1 when Shutdown = infinity, this walue is only allowed "
"for children of type supervisor"];
@@ -594,7 +587,6 @@ child_specs(Config) when is_list(Config) ->
?line ok = supervisor:check_childspecs([C3]),
?line ok = supervisor:check_childspecs([C4]),
ok.
-%-------------------------------------------------------------------------
%-------------------------------------------------------------------------
permanent_normal(doc) ->
@@ -656,7 +648,6 @@ temporary_normal(Config) when is_list(Config) ->
?line [1,0,0,1] = get_child_counts(sup_test),
ok.
-%-------------------------------------------------------------------------
%-------------------------------------------------------------------------
permanent_abnormal(doc) ->
@@ -725,8 +716,6 @@ temporary_abnormal(Config) when is_list(Config) ->
ok.
%-------------------------------------------------------------------------
-
-%-------------------------------------------------------------------------
one_for_one(doc) ->
["Test the one_for_one base case."];
one_for_one(suite) -> [];
@@ -805,8 +794,6 @@ one_for_one_escalation(Config) when is_list(Config) ->
end,
ok.
%-------------------------------------------------------------------------
-
-%-------------------------------------------------------------------------
one_for_all(doc) ->
["Test the one_for_all base case."];
one_for_all(suite) -> [];
@@ -894,8 +881,6 @@ one_for_all_escalation(Config) when is_list(Config) ->
ok.
%-------------------------------------------------------------------------
-
-%-------------------------------------------------------------------------
simple_one_for_one(doc) ->
["Test the simple_one_for_one base case."];
simple_one_for_one(suite) -> [];
@@ -1012,8 +997,6 @@ simple_one_for_one_escalation(Config) when is_list(Config) ->
end,
ok.
%-------------------------------------------------------------------------
-
-%-------------------------------------------------------------------------
rest_for_one(doc) ->
["Test the rest_for_one base case."];
rest_for_one(suite) -> [];
@@ -1287,7 +1270,9 @@ tree(Config) when is_list(Config) ->
ok.
%-------------------------------------------------------------------------
count_children_memory(doc) ->
- ["Test that which_children eats memory, but count_children does not."];
+ ["Test that count_children does not eat memory."];
+count_children_memory(suite) ->
+ [];
count_children_memory(Config) when is_list(Config) ->
process_flag(trap_exit, true),
Child = {child, {supervisor_1, start_child, []}, temporary, 1000,
@@ -1300,7 +1285,7 @@ count_children_memory(Config) when is_list(Config) ->
Children = supervisor:which_children(sup_test),
_Size2 = erlang:memory(processes_used),
ChildCount = get_child_counts(sup_test),
- Size3 = erlang:memory(processes_used),
+ _Size3 = erlang:memory(processes_used),
[supervisor:start_child(sup_test, []) || _Ignore2 <- lists:seq(1,1000)],
@@ -1324,8 +1309,8 @@ count_children_memory(Config) when is_list(Config) ->
?line ChildCount3 = ChildCount2,
%% count_children consumes memory using an accumulator function,
- %% but the space can be reclaimed incrementally, whereas
- %% which_children generates a return list.
+ %% but the space can be reclaimed incrementally,
+ %% which_children may generate garbage that will reclaimed later.
case (Size5 =< Size4) of
true -> ok;
false ->
@@ -1337,23 +1322,10 @@ count_children_memory(Config) when is_list(Config) ->
?line test_server:fail({count_children, used_more_memory})
end,
- case Size4 > Size3 of
- true -> ok;
- false ->
- ?line test_server:fail({which_children, used_no_memory})
- end,
- case Size6 > Size5 of
- true -> ok;
- false ->
- ?line test_server:fail({which_children, used_no_memory})
- end,
-
[exit(Pid, kill) || {undefined, Pid, worker, _Modules} <- Children3],
test_server:sleep(100),
?line [1,0,0,0] = get_child_counts(sup_test),
-
ok.
-
count_children_allocator_test(MemoryState) ->
Allocators = [temp_alloc, eheap_alloc, binary_alloc, ets_alloc,
driver_alloc, sl_alloc, ll_alloc, fix_alloc, std_alloc,
@@ -1364,3 +1336,84 @@ count_children_allocator_test(MemoryState) ->
AllocStates = [lists:keyfind(e, 1, AllocValue)
|| {_Type, AllocValue} <- AllocTypes],
lists:all(fun(State) -> State == {e, true} end, AllocStates).
+%-------------------------------------------------------------------------
+do_not_save_start_parameters_for_temporary_children(doc) ->
+ ["Temporary children shall not be restarted so they should not"
+ "save start parameters, as it potentially can"
+ "take up a huge amount of memory for no purpose."];
+do_not_save_start_parameters_for_temporary_children(suite) ->
+ [];
+do_not_save_start_parameters_for_temporary_children(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ dont_save_start_parameters_for_temporary_children(one_for_all),
+ dont_save_start_parameters_for_temporary_children(one_for_one),
+ dont_save_start_parameters_for_temporary_children(rest_for_one),
+ dont_save_start_parameters_for_temporary_children(simple_one_for_one).
+
+dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) ->
+ Permanent = {child, {supervisor_1, start_child, []},
+ permanent, 1000, worker, []},
+ Transient = {child, {supervisor_1, start_child, []},
+ transient, 1000, worker, []},
+ Temporary = {child, {supervisor_1, start_child, []},
+ temporary, 1000, worker, []},
+ {ok, Sup1} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Permanent]}}),
+ {ok, Sup2} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Transient]}}),
+ {ok, Sup3} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, [Temporary]}}),
+
+ LargeList = lists:duplicate(10, "Potentially large"),
+
+ start_children(Sup1, [LargeList], 100),
+ start_children(Sup2, [LargeList], 100),
+ start_children(Sup3, [LargeList], 100),
+
+ [{memory,Mem1}] = process_info(Sup1, [memory]),
+ [{memory,Mem2}] = process_info(Sup2, [memory]),
+ [{memory,Mem3}] = process_info(Sup3, [memory]),
+
+ true = (Mem3 < Mem1) and (Mem3 < Mem2),
+
+ exit(Sup1, shutdown),
+ exit(Sup2, shutdown),
+ exit(Sup3, shutdown);
+
+dont_save_start_parameters_for_temporary_children(Type) ->
+ {ok, Sup1} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}),
+ {ok, Sup2} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}),
+ {ok, Sup3} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}),
+
+ LargeList = lists:duplicate(10, "Potentially large"),
+
+ Permanent = {child1, {supervisor_1, start_child, [LargeList]},
+ permanent, 1000, worker, []},
+ Transient = {child2, {supervisor_1, start_child, [LargeList]},
+ transient, 1000, worker, []},
+ Temporary = {child3, {supervisor_1, start_child, [LargeList]},
+ temporary, 1000, worker, []},
+
+ start_children(Sup1, Permanent, 100),
+ start_children(Sup2, Transient, 100),
+ start_children(Sup3, Temporary, 100),
+
+ [{memory,Mem1}] = process_info(Sup1, [memory]),
+ [{memory,Mem2}] = process_info(Sup2, [memory]),
+ [{memory,Mem3}] = process_info(Sup3, [memory]),
+
+ true = (Mem3 < Mem1) and (Mem3 < Mem2),
+
+ exit(Sup1, shutdown),
+ exit(Sup2, shutdown),
+ exit(Sup3, shutdown).
+
+start_children(_,_, 0) ->
+ ok;
+start_children(Sup, Args, N) ->
+ Spec = child_spec(Args, N),
+ {ok, _, _} = supervisor:start_child(Sup, Spec),
+ start_children(Sup, Args, N-1).
+
+child_spec([_|_] = SimpleOneForOneArgs, _) ->
+ SimpleOneForOneArgs;
+child_spec({Name, MFA, RestartType, Shutdown, Type, Modules}, N) ->
+ NewName = list_to_atom((atom_to_list(Name) ++ integer_to_list(N))),
+ {NewName, MFA, RestartType, Shutdown, Type, Modules}.
diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile
index 9fe5aee3bb..0648c1f96a 100644
--- a/lib/test_server/test/Makefile
+++ b/lib/test_server/test/Makefile
@@ -27,11 +27,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
MODULES= \
test_server_SUITE \
test_server_line_SUITE \
- test_server_skip_SUITE \
- test_server_conf01_SUITE \
- test_server_conf02_SUITE \
- test_server_parallel01_SUITE \
- test_server_shuffle01_SUITE
+ test_server_test_lib
ERL_FILES= $(MODULES:%=%.erl)
@@ -52,6 +48,7 @@ RELSYSDIR = $(RELEASE_PATH)/test_server_test
ERL_MAKE_FLAGS += -pa $(ERL_TOP)/lib/test_server/ebin
ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include
+ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/test
EBIN = .
diff --git a/lib/test_server/test/test_server.spec b/lib/test_server/test/test_server.spec
index 23b0b71963..a3b4d01d08 100644
--- a/lib/test_server/test/test_server.spec
+++ b/lib/test_server/test/test_server.spec
@@ -1,2 +1 @@
-{topcase, {dir, "../test_server_test"}}.
-{skip,{test_server_SUITE,skip_case7,"This case should be noted as `Skipped'"}}.
+{suites, "../test_server_test", all}.
diff --git a/lib/test_server/test/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE.erl
index 0563e1104f..f4c19eeaf9 100644
--- a/lib/test_server/test/test_server_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -16,539 +16,149 @@
%%
%% %CopyrightEnd%
%%
-
-%%%------------------------------------------------------------------
-%%% Test Server self test.
-%%%------------------------------------------------------------------
+%%%-------------------------------------------------------------------
+%%% @author Lukas Larsson <[email protected]>
+%%% @copyright (C) 2011, Erlang Solutions Ltd.
+%%% @doc
+%%%
+%%% @end
+%%% Created : 15 Feb 2011 by Lukas Larsson <[email protected]>
+%%%-------------------------------------------------------------------
-module(test_server_SUITE).
--include_lib("test_server/include/test_server.hrl").
--include_lib("test_server/include/test_server_line.hrl").
--include_lib("kernel/include/file.hrl").
--export([all/1]).
--export([init_per_suite/1, end_per_suite/1]).
--export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]).
--export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1,
- init_per_s/1, init_per_tc/1, end_per_tc/1,
- timeconv/1, msgs/1, capture/1, timecall/1,
- do_times/1, do_times_mfa/1, do_times_fun/1,
- skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1,
- skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1,
- skip_case8/1, skip_case9/1, undefined_functions/1,
- conf_init/1, check_new_conf/1, conf_cleanup/1,
- check_old_conf/1, conf_init_fail/1, start_stop_node/1,
- cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1,
- commercial/1]).
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include("test_server_test_lib.hrl").
--export([dummy_function/0,dummy_function/1,doer/1]).
+%%--------------------------------------------------------------------
+%% COMMON TEST CALLBACK FUNCTIONS
+%%--------------------------------------------------------------------
-all(doc) -> ["Test Server self test"];
-all(suite) ->
- [config, comment, timetrap, timetrap_cancel, multiply_timetrap,
- init_per_s, init_per_tc, end_per_tc,
- timeconv, msgs, capture, timecall, do_times, skip_cases,
- undefined_functions, commercial,
- {conf, conf_init, [check_new_conf], conf_cleanup},
- check_old_conf,
- {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip},
- start_stop_node,
- {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin},
- config
- ].
+%% @spec suite() -> Info
+suite() ->
+ [{ct_hooks,[ts_install_cth,test_server_test_lib]}].
+%% @spec init_per_suite(Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
init_per_suite(Config) ->
- [{init_per_suite_var,ok}|Config].
+ [{path_dirs,[proplists:get_value(data_dir,Config)]} | Config].
+%% @spec end_per_suite(Config) -> _
end_per_suite(_Config) ->
- ok.
-
-init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog = ?t:timetrap(?t:minutes(2)),
- Config1 = [{watchdog, Dog}|Config],
- case Func of
- init_per_tc ->
- [{strange_var, 1}|Config1];
- skip_case8 ->
- {skipped, "This case should be noted as `Skipped'"};
- skip_case9 ->
- {skip, "This case should be noted as `Skipped'"};
- _ ->
- Config1
- end;
-init_per_testcase(Func, Config) ->
- io:format("Func:~p",[Func]),
- io:format("Config:~p",[Config]),
- ?t:fail("Arguments to init_per_testcase not correct").
-
-end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
- Dog=?config(watchdog, Config),
- ?t:timetrap_cancel(Dog),
- case Func of
- end_per_tc -> io:format("CLEANUP => this test case is ok\n");
- _Other -> ok
- end;
-end_per_testcase(Func, Config) ->
- io:format("Func:~p",[Func]),
- io:format("Config:~p",[Config]),
- ?t:fail("Arguments to end_per_testcase not correct").
-
-fin_per_testcase(Func, Config) ->
- io:format("Func:~p",[Func]),
- io:format("Config:~p",[Config]),
- ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2").
+ io:format("TEST_SERVER_FRAMEWORK: ~p",[os:getenv("TEST_SERVER_FRAMEWORK")]),
+ ok.
+
+%% @spec init_per_group(GroupName, Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+init_per_group(_GroupName, Config) ->
+ Config.
+
+%% @spec end_per_group(GroupName, Config0) ->
+%% void() | {save_config,Config1}
+end_per_group(_GroupName, _Config) ->
+ ok.
+
+%% @spec init_per_testcase(TestCase, Config0) ->
+%% Config1 | {skip,Reason} | {skip_and_save,Reason,Config1}
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+%% @spec end_per_testcase(TestCase, Config0) ->
+%% void() | {save_config,Config1} | {fail,Reason}
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+%% @spec: groups() -> [Group]
+groups() ->
+ [].
+
+%% @spec all() -> GroupsAndTestCases | {skip,Reason}
+all() ->
+ [test_server_SUITE, test_server_parallel01_SUITE,
+ test_server_conf02_SUITE, test_server_conf01_SUITE,
+ test_server_skip_SUITE, test_server_shuffle01_SUITE].
+
+
+%%--------------------------------------------------------------------
+%% TEST CASES
+%%--------------------------------------------------------------------
+%% @spec TestCase(Config0) ->
+%% ok | exit() | {skip,Reason} | {comment,Comment} |
+%% {save_config,Config1} | {skip_and_save,Reason,Config1}
+test_server_SUITE(Config) ->
+% rpc:call(Node,dbg, tracer,[]),
+% rpc:call(Node,dbg, p,[all,c]),
+% rpc:call(Node,dbg, tpl,[test_server_ctrl,x]),
+ run_test_server_tests("test_server_SUITE", 39, 1, 31,
+ 20, 9, 1, 11, 2, 26, Config).
+
+test_server_parallel01_SUITE(Config) ->
+ run_test_server_tests("test_server_parallel01_SUITE", 37, 0, 19,
+ 19, 0, 0, 0, 0, 37, Config).
+
+test_server_shuffle01_SUITE(Config) ->
+ run_test_server_tests("test_server_shuffle01_SUITE", 130, 0, 0,
+ 76, 0, 0, 0, 0, 130, Config).
+
+test_server_skip_SUITE(Config) ->
+ run_test_server_tests("test_server_skip_SUITE", 3, 0, 1,
+ 0, 0, 1, 3, 0, 0, Config).
+
+test_server_conf01_SUITE(Config) ->
+ run_test_server_tests("test_server_conf01_SUITE", 24, 0, 12,
+ 12, 0, 0, 0, 0, 24, Config).
+
+test_server_conf02_SUITE(Config) ->
+ run_test_server_tests("test_server_conf02_SUITE", 26, 0, 12,
+ 12, 0, 0, 0, 0, 26, Config).
+
+
+run_test_server_tests(SuiteName, NCases, NFail, NExpected, NSucc,
+ NUsrSkip, NAutoSkip,
+ NActualSkip, NActualFail, NActualSucc, Config) ->
+ Node = proplists:get_value(node, Config),
+ {ok,_Pid} = rpc:call(Node,test_server_ctrl, start, []),
+ rpc:call(Node,
+ test_server_ctrl,add_dir_with_skip,
+ [SuiteName,
+ [proplists:get_value(data_dir,Config)],SuiteName,
+ [{test_server_SUITE,skip_case7,"SKIPPED!"}]]),
+
+ until(fun() ->
+ rpc:call(Node,test_server_ctrl,jobs,[]) =:= []
+ end),
-
-config(suite) -> [];
-config(doc) -> ["Test that the Config variable is decent, ",
- "and that the std config variables are correct ",
- "(check that data/priv dir exists)."
- "Also check that ?config macro works."];
-config(Config) when is_list(Config) ->
- is_tuplelist(Config),
- {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config),
- {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config),
- true=is_dir(Dd),
- {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")),
- true=is_dir(Dp),
-
- Dd = ?config(data_dir,Config),
- Dp = ?config(priv_dir,Config),
- ok;
-config(_Config) ->
- ?t:fail("Config variable is not a list.").
-
-is_tuplelist([]) ->
- true;
-is_tuplelist([{_A,_B}|Rest]) ->
- is_tuplelist(Rest);
-is_tuplelist(_) ->
- false.
-
-is_dir(Dir) ->
- case file:read_file_info(Dir) of
- {ok, #file_info{type=directory}} ->
- true;
- _ ->
- false
- end.
-
-comment(suite) -> [];
-comment(doc) -> ["Print a comment in the HTML log"];
-comment(Config) when is_list(Config) ->
- ?t:comment("This comment should not occur in the HTML log because a later"
- " comment shall overwrite it"),
- ?t:comment("This comment is printed with the comment/1 function."
- " It should occur in the HTML log").
-
-
-
-timetrap(suite) -> [];
-timetrap(doc) -> ["Test that timetrap works."];
-timetrap(Config) when is_list(Config) ->
- TrapAfter = 3000,
- Dog=?t:timetrap(TrapAfter),
- process_flag(trap_exit, true),
- TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000,
- receive
- {'EXIT', Dog, {timetrap_timeout, _, _}} ->
- ok;
- {'EXIT', _OtherPid, {timetrap_timeout, _, _}} ->
- ?t:fail("EXIT signal from wrong process")
- after
- TimeOut ->
- ?t:fail("Timetrap is not working.")
- end,
- ?t:timetrap_cancel(Dog),
- ok.
-
-
-timetrap_cancel(suite) -> [];
-timetrap_cancel(doc) -> ["Test that timetrap_cancel works."];
-timetrap_cancel(Config) when is_list(Config) ->
- Dog=?t:timetrap(1000),
- receive
- after
- 500 ->
- ok
- end,
- ?t:timetrap_cancel(Dog),
- receive
- after 1000 ->
- ok
- end,
- ok.
-
-multiply_timetrap(suite) -> [];
-multiply_timetrap(doc) -> ["Test multiply timetrap"];
-multiply_timetrap(Config) when is_list(Config) ->
- %% This simulates the call to test_server_ctrl:multiply_timetraps/1:
- put(test_server_multiply_timetraps,{2,true}),
-
- Dog = ?t:timetrap(500),
- timer:sleep(800),
- ?t:timetrap_cancel(Dog),
-
- %% Reset
- put(test_server_multiply_timetraps,1),
- ok.
-
-
-init_per_s(suite) -> [];
-init_per_s(doc) -> ["Test that a Config that is altered in ",
- "init_per_suite gets through to the testcases."];
-init_per_s(Config) ->
- %% Check that the config var sent from init_per_suite
- %% really exists.
- {value, {init_per_suite_var, ok}} =
- lists:keysearch(init_per_suite_var,1,Config),
-
- %% Check that the other variables still exist.
- {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config),
- {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config),
- ok.
-
-init_per_tc(suite) -> [];
-init_per_tc(doc) -> ["Test that a Config that is altered in ",
- "init_per_testcase gets through to the ",
- "actual testcase."];
-init_per_tc(Config) ->
- %% Check that the config var sent from init_per_testcase
- %% really exists.
- {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config),
-
- %% Check that the other variables still exist.
- {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config),
- {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config),
- ok.
-
-end_per_tc(suite) -> [];
-end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if"
- " test case fails"];
-end_per_tc(Config) when is_list(Config) ->
- ?t:fail("This case should fail! Check that \"CLEANUP\" is"
- " printed in the minor log file.").
-
-
-timeconv(suite) -> [];
-timeconv(doc) -> ["Test that the time unit conversion functions ",
- "works."];
-timeconv(Config) when is_list(Config) ->
- Val=2,
- Secs=Val*1000,
- Mins=Secs*60,
- Hrs=Mins*60,
- Secs=?t:seconds(2),
- Mins=?t:minutes(2),
- Hrs=?t:hours(2),
- ok.
-
-
-msgs(suite) -> [];
-msgs(doc) -> ["Tests the messages_get function."];
-msgs(Config) when is_list(Config) ->
- self() ! {hej, du},
- self() ! {lite, "data"},
- self() ! en_atom,
- [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(),
- ok.
-
-capture(suite) -> [];
-capture(doc) -> ["Test that the capture functions work properly."];
-capture(Config) when is_list(Config) ->
- String1="abcedfghjiklmnopqrstuvwxyz",
- String2="0123456789",
- ?t:capture_start(),
- io:format(String1),
- [String1]=?t:capture_get(),
- io:format(String2),
- [String2]=?t:capture_get(),
- ?t:capture_stop(),
- []=?t:capture_get(),
- io:format(String2),
- []=?t:capture_get(),
- ok.
-
-timecall(suite) -> [];
-timecall(doc) -> ["Tests that timed calls work."];
-timecall(Config) when is_list(Config) ->
- {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []),
- {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]),
- DTime=round(Time2),
- if
- DTime<1 ->
- ?t:fail("Timecall reported a too low time.");
- DTime==1 ->
+ rpc:call(Node,test_server_ctrl, stop, []),
+ {ok,#suite{ n_cases = NCases,
+ n_cases_failed = NFail,
+ n_cases_expected = NExpected,
+ n_cases_succ = NSucc,
+ n_cases_user_skip = NUsrSkip,
+ n_cases_auto_skip = NAutoSkip,
+ cases = Cases }} = Data =
+ test_server_test_lib:parse_suite(
+ hd(filelib:wildcard(
+ filename:join([proplists:get_value(priv_dir, Config),
+ SuiteName++".logs","run*","suite.log"])))),
+ {NActualSkip,NActualFail,NActualSucc} =
+ lists:foldl(fun(#tc{ result = skip },{S,F,Su}) ->
+ {S+1,F,Su};
+ (#tc{ result = ok },{S,F,Su}) ->
+ {S,F,Su+1};
+ (#tc{ result = failed },{S,F,Su}) ->
+ {S,F+1,Su}
+ end,{0,0,0},Cases),
+ Data.
+
+until(Fun) ->
+ case Fun() of
+ true ->
ok;
- DTime>1 ->
- ?t:fail("Timecall reported a too high time.")
- end,
- ok.
-
-dummy_function() ->
- liten_apa_e_oxo_farlig.
-dummy_function(gorilla) ->
- receive after 1000 -> ok end,
- jag_ar_en_gorilla.
-
-
-do_times(suite) -> [do_times_mfa, do_times_fun];
-do_times(doc) -> ["Test the do_times function."].
-
-do_times_mfa(suite) -> [];
-do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."];
-do_times_mfa(Config) when is_list(Config) ->
- ?t:do_times(100, ?MODULE, doer, [self()]),
- 100=length(?t:messages_get()),
- ok.
-
-do_times_fun(suite) -> [];
-do_times_fun(doc) -> ["Test the do_times function with fun given."];
-do_times_fun(Config) when is_list(Config) ->
- Self = self(),
- ?t:do_times(100, fun() -> doer(Self) end),
- 100=length(?t:messages_get()),
- ok.
-
-doer(From) ->
- From ! a,
- ok.
-
-skip_cases(doc) -> ["Test all possible ways to skip a test case."];
-skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4,
- skip_case5, skip_case6, skip_case7, skip_case8,
- skip_case9].
-
-skip_case1(suite) -> [];
-skip_case1(doc) -> ["Test that you can return {skipped, Reason},"
- " and that Reason is in the comment field in the HTML log"];
-skip_case1(Config) when is_list(Config) ->
- %% If this comment shows, the case failed!!
- ?t:comment("ERROR: This case should have been noted as `Skipped'"),
- %% The Reason in {skipped, Reason} should overwrite a 'comment'
- {skipped, "This case should be noted as `Skipped'"}.
-
-skip_case2(suite) -> [];
-skip_case2(doc) -> ["Test that you can return {skipped, Reason},"
- " and that Reason is in the comment field in the HTML log"];
-skip_case2(Config) when is_list(Config) ->
- %% If this comment shows, the case failed!!
- ?t:comment("ERROR: This case should have been noted as `Skipped'"),
- %% The Reason in {skipped, Reason} should overwrite a 'comment'
- exit({skipped, "This case should be noted as `Skipped'"}).
-
-skip_case3(suite) -> [];
-skip_case3(doc) -> ["Test that you can return {skip, Reason},"
- " and that Reason is in the comment field in the HTML log"];
-skip_case3(Config) when is_list(Config) ->
- %% If this comment shows, the case failed!!
- ?t:comment("ERROR: This case should have been noted as `Skipped'"),
- %% The Reason in {skip, Reason} should overwrite a 'comment'
- {skip, "This case should be noted as `Skipped'"}.
-
-skip_case4(suite) -> [];
-skip_case4(doc) -> ["Test that you can return {skip, Reason},"
- " and that Reason is in the comment field in the HTML log"];
-skip_case4(Config) when is_list(Config) ->
- %% If this comment shows, the case failed!!
- ?t:comment("ERROR: This case should have been noted as `Skipped'"),
- %% The Reason in {skip, Reason} should overwrite a 'comment'
- exit({skip, "This case should be noted as `Skipped'"}).
-
-skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"};
-skip_case5(doc) -> ["Test that you can return {skipped, Reason}"
- " from the specification clause"].
-
-skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"};
-skip_case6(doc) -> ["Test that you can return {skip, Reason}"
- " from the specification clause"].
-
-skip_case7(suite) -> [];
-skip_case7(doc) -> ["Test that skip works from a test specification file"];
-skip_case7(Config) when is_list(Config) ->
- %% This case shall be skipped by adding
- %% {skip, {test_server_SUITE, skip_case7, Reason}}.
- %% to the test specification file.
- ?t:fail("This case should have been Skipped by the .spec file").
-
-skip_case8(suite) -> [];
-skip_case8(doc) -> ["Test that {skipped, Reason} works from"
- " init_per_testcase/2"];
-skip_case8(Config) when is_list(Config) ->
- %% This case shall be skipped by adding a specific clause to
- %% returning {skipped, Reason} from init_per_testcase/2 for this case.
- ?t:fail("This case should have been Skipped by init_per_testcase/2").
-
-skip_case9(suite) -> [];
-skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"];
-skip_case9(Config) when is_list(Config) ->
- %% This case shall be skipped by adding a specific clause to
- %% returning {skip, Reason} from init_per_testcase/2 for this case.
- ?t:fail("This case should have been Skipped by init_per_testcase/2").
-
-undefined_functions(suite) -> [];
-undefined_functions(doc) -> ["Check for calls to undefined functions in"
- " test_server."
- "Skip if cover is running"];
-undefined_functions(Config) when is_list(Config) ->
- case whereis(cover_server) of
- Pid when is_pid(Pid) ->
- {skip,"Cover is running"};
- undefined ->
- undefined_functions()
- end.
-
-undefined_functions() ->
- TestServerDir = filename:dirname(code:which(test_server)),
- Res = xref:d(TestServerDir),
-
- {value,{unused,Unused}} = lists:keysearch(unused, 1, Res),
- case Unused of
- [] -> ok;
- _ ->
- lists:foreach(fun (MFA) ->
- io:format("~s unused", [format_mfa(MFA)])
- end, Unused)
- end,
-
- {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res),
- Undef = [U || U <- Undef0, not unresolved(U)],
- case Undef of
- [] -> ok;
- _ ->
- lists:foreach(fun ({MFA1,MFA2}) ->
- io:format("~s calls undefined ~s",
- [format_mfa(MFA1),format_mfa(MFA2)])
- end, Undef),
- ?t:fail({length(Undef),undefined_functions_in_otp})
- end,
- ok.
-
-unresolved({_,{_,'$F_EXPR',_}}) -> true;
-unresolved(_) -> false.
-
-format_mfa({M,F,A}) ->
- lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])).
-
-conf_init(doc) -> ["Test successful conf case: Change Config parameter"];
-conf_init(Config) when is_list(Config) ->
- [{conf_init_var,1389}|Config].
-
-check_new_conf(suite) -> [];
-check_new_conf(doc) -> ["Check that Config parameter changed by"
- " conf_init is used"];
-check_new_conf(Config) when is_list(Config) ->
- 1389 = ?config(conf_init_var,Config),
- ok.
-
-conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"];
-conf_cleanup(Config) when is_list(Config) ->
- lists:keydelete(conf_init_var,1,Config).
-
-check_old_conf(suite) -> [];
-check_old_conf(doc) -> ["Test that the restored Config is used after a"
- " conf cleanup"];
-check_old_conf(Config) when is_list(Config) ->
- undefined = ?config(conf_init_var,Config),
- ok.
-
-conf_init_fail(doc) -> ["Test that config members are skipped if"
- " conf init function fails."];
-conf_init_fail(Config) when is_list(Config) ->
- ?t:fail("This case should fail! Check that conf_member_skip and"
- " conf_cleanup_skip are skipped.").
-
-
-
-start_stop_node(suite) -> [];
-start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"];
-start_stop_node(Config) when is_list(Config) ->
- {ok,Node2} = ?t:start_node(node2,peer,[]),
- {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]),
- true = lists:member(Node2,nodes()),
-
- {ok,Node3} = ?t:start_node(node3,slave,[]),
- {error, _} = ?t:start_node(node3,slave,[]),
- true = lists:member(Node3,nodes()),
-
- {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]),
- case lists:member(Node4,nodes()) of
- true ->
- ?t:comment("WARNING: Node started with {wait,false}"
- " is up faster than expected...");
false ->
- wait_for_node(Node4,0),
- true = lists:member(Node4,nodes())
- end,
-
- true = ?t:stop_node(Node2),
- false = lists:member(Node2,nodes()),
-
- true = ?t:stop_node(Node3),
- false = lists:member(Node3,nodes()),
-
- true = ?t:stop_node(Node4),
- false = lists:member(Node4,nodes()),
- timer:sleep(2000),
- false = ?t:stop_node(Node4),
-
- ok.
-
-
-wait_for_node(Node,Acc) ->
- case net_adm:ping(Node) of
- pang ->
timer:sleep(100),
- wait_for_node(Node,Acc+100);
- pong ->
- Acc
+ until(Fun)
end.
-
-cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case"
- " is finished unless {cleanup,false} is given."];
-cleanup_nodes_init(Config) when is_list(Config) ->
- {ok,DieSlave} = ?t:start_node(die_slave, slave, []),
- {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]),
- {ok,DiePeer} = ?t:start_node(die_peer, peer, []),
- {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]),
- [{die_slave,DieSlave},
- {survive_slave,SurviveSlave},
- {die_peer,DiePeer},
- {survive_peer,SurvivePeer} | Config].
-
-
-
-check_survive_nodes(suite) -> [];
-check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"];
-check_survive_nodes(Config) when is_list(Config) ->
- timer:sleep(1000),
- false = lists:member(?config(die_slave,Config),nodes()),
- true = lists:member(?config(survive_slave,Config),nodes()),
- false = lists:member(?config(die_peer,Config),nodes()),
- true = lists:member(?config(survive_peer,Config),nodes()),
- ok.
-
-
-cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}"
- " can be stopped"];
-cleanup_nodes_fin(Config) when is_list(Config) ->
- Slave = ?config(survive_slave,Config),
- Peer = ?config(survive_peer,Config),
-
- true = ?t:stop_node(Slave),
- false = lists:member(Slave,nodes()),
- true = ?t:stop_node(Peer),
- false = lists:member(Peer,nodes()),
-
- C1 = lists:keydelete(die_slave,1,Config),
- C2 = lists:keydelete(survive_slave,1,C1),
- C3 = lists:keydelete(die_peer,1,C2),
- lists:keydelete(survive_peer,1,C3).
-
-commercial(Config) when is_list(Config) ->
- case ?t:is_commercial() of
- false -> {comment,"Open-source build"};
- true -> {comment,"Commercial build"}
- end.
-
-
+
diff --git a/lib/test_server/test/test_server_SUITE_data/Makefile.src b/lib/test_server/test/test_server_SUITE_data/Makefile.src
new file mode 100644
index 0000000000..d5af919eec
--- /dev/null
+++ b/lib/test_server/test/test_server_SUITE_data/Makefile.src
@@ -0,0 +1,2 @@
+all:
+ erlc *.erl \ No newline at end of file
diff --git a/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl
new file mode 100644
index 0000000000..0563e1104f
--- /dev/null
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE.erl
@@ -0,0 +1,554 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1997-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%%------------------------------------------------------------------
+%%% Test Server self test.
+%%%------------------------------------------------------------------
+-module(test_server_SUITE).
+-include_lib("test_server/include/test_server.hrl").
+-include_lib("test_server/include/test_server_line.hrl").
+-include_lib("kernel/include/file.hrl").
+-export([all/1]).
+
+-export([init_per_suite/1, end_per_suite/1]).
+-export([init_per_testcase/2, end_per_testcase/2, fin_per_testcase/2]).
+-export([config/1, comment/1, timetrap/1, timetrap_cancel/1, multiply_timetrap/1,
+ init_per_s/1, init_per_tc/1, end_per_tc/1,
+ timeconv/1, msgs/1, capture/1, timecall/1,
+ do_times/1, do_times_mfa/1, do_times_fun/1,
+ skip_cases/1, skip_case1/1, skip_case2/1, skip_case3/1,
+ skip_case4/1, skip_case5/1, skip_case6/1, skip_case7/1,
+ skip_case8/1, skip_case9/1, undefined_functions/1,
+ conf_init/1, check_new_conf/1, conf_cleanup/1,
+ check_old_conf/1, conf_init_fail/1, start_stop_node/1,
+ cleanup_nodes_init/1, check_survive_nodes/1, cleanup_nodes_fin/1,
+ commercial/1]).
+
+-export([dummy_function/0,dummy_function/1,doer/1]).
+
+all(doc) -> ["Test Server self test"];
+all(suite) ->
+ [config, comment, timetrap, timetrap_cancel, multiply_timetrap,
+ init_per_s, init_per_tc, end_per_tc,
+ timeconv, msgs, capture, timecall, do_times, skip_cases,
+ undefined_functions, commercial,
+ {conf, conf_init, [check_new_conf], conf_cleanup},
+ check_old_conf,
+ {conf, conf_init_fail,[conf_member_skip],conf_cleanup_skip},
+ start_stop_node,
+ {conf, cleanup_nodes_init,[check_survive_nodes],cleanup_nodes_fin},
+ config
+ ].
+
+
+init_per_suite(Config) ->
+ [{init_per_suite_var,ok}|Config].
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Dog = ?t:timetrap(?t:minutes(2)),
+ Config1 = [{watchdog, Dog}|Config],
+ case Func of
+ init_per_tc ->
+ [{strange_var, 1}|Config1];
+ skip_case8 ->
+ {skipped, "This case should be noted as `Skipped'"};
+ skip_case9 ->
+ {skip, "This case should be noted as `Skipped'"};
+ _ ->
+ Config1
+ end;
+init_per_testcase(Func, Config) ->
+ io:format("Func:~p",[Func]),
+ io:format("Config:~p",[Config]),
+ ?t:fail("Arguments to init_per_testcase not correct").
+
+end_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
+ Dog=?config(watchdog, Config),
+ ?t:timetrap_cancel(Dog),
+ case Func of
+ end_per_tc -> io:format("CLEANUP => this test case is ok\n");
+ _Other -> ok
+ end;
+end_per_testcase(Func, Config) ->
+ io:format("Func:~p",[Func]),
+ io:format("Config:~p",[Config]),
+ ?t:fail("Arguments to end_per_testcase not correct").
+
+fin_per_testcase(Func, Config) ->
+ io:format("Func:~p",[Func]),
+ io:format("Config:~p",[Config]),
+ ?t:fail("fin_per_testcase/2 called, should have called end_per_testcase/2").
+
+
+config(suite) -> [];
+config(doc) -> ["Test that the Config variable is decent, ",
+ "and that the std config variables are correct ",
+ "(check that data/priv dir exists)."
+ "Also check that ?config macro works."];
+config(Config) when is_list(Config) ->
+ is_tuplelist(Config),
+ {value,{data_dir,Dd}}=lists:keysearch(data_dir,1,Config),
+ {value,{priv_dir,Dp}}=lists:keysearch(priv_dir,1,Config),
+ true=is_dir(Dd),
+ {ok, _Bin}=file:read_file(filename:join(Dd, "dummy_file")),
+ true=is_dir(Dp),
+
+ Dd = ?config(data_dir,Config),
+ Dp = ?config(priv_dir,Config),
+ ok;
+config(_Config) ->
+ ?t:fail("Config variable is not a list.").
+
+is_tuplelist([]) ->
+ true;
+is_tuplelist([{_A,_B}|Rest]) ->
+ is_tuplelist(Rest);
+is_tuplelist(_) ->
+ false.
+
+is_dir(Dir) ->
+ case file:read_file_info(Dir) of
+ {ok, #file_info{type=directory}} ->
+ true;
+ _ ->
+ false
+ end.
+
+comment(suite) -> [];
+comment(doc) -> ["Print a comment in the HTML log"];
+comment(Config) when is_list(Config) ->
+ ?t:comment("This comment should not occur in the HTML log because a later"
+ " comment shall overwrite it"),
+ ?t:comment("This comment is printed with the comment/1 function."
+ " It should occur in the HTML log").
+
+
+
+timetrap(suite) -> [];
+timetrap(doc) -> ["Test that timetrap works."];
+timetrap(Config) when is_list(Config) ->
+ TrapAfter = 3000,
+ Dog=?t:timetrap(TrapAfter),
+ process_flag(trap_exit, true),
+ TimeOut = TrapAfter * test_server:timetrap_scale_factor() + 1000,
+ receive
+ {'EXIT', Dog, {timetrap_timeout, _, _}} ->
+ ok;
+ {'EXIT', _OtherPid, {timetrap_timeout, _, _}} ->
+ ?t:fail("EXIT signal from wrong process")
+ after
+ TimeOut ->
+ ?t:fail("Timetrap is not working.")
+ end,
+ ?t:timetrap_cancel(Dog),
+ ok.
+
+
+timetrap_cancel(suite) -> [];
+timetrap_cancel(doc) -> ["Test that timetrap_cancel works."];
+timetrap_cancel(Config) when is_list(Config) ->
+ Dog=?t:timetrap(1000),
+ receive
+ after
+ 500 ->
+ ok
+ end,
+ ?t:timetrap_cancel(Dog),
+ receive
+ after 1000 ->
+ ok
+ end,
+ ok.
+
+multiply_timetrap(suite) -> [];
+multiply_timetrap(doc) -> ["Test multiply timetrap"];
+multiply_timetrap(Config) when is_list(Config) ->
+ %% This simulates the call to test_server_ctrl:multiply_timetraps/1:
+ put(test_server_multiply_timetraps,{2,true}),
+
+ Dog = ?t:timetrap(500),
+ timer:sleep(800),
+ ?t:timetrap_cancel(Dog),
+
+ %% Reset
+ put(test_server_multiply_timetraps,1),
+ ok.
+
+
+init_per_s(suite) -> [];
+init_per_s(doc) -> ["Test that a Config that is altered in ",
+ "init_per_suite gets through to the testcases."];
+init_per_s(Config) ->
+ %% Check that the config var sent from init_per_suite
+ %% really exists.
+ {value, {init_per_suite_var, ok}} =
+ lists:keysearch(init_per_suite_var,1,Config),
+
+ %% Check that the other variables still exist.
+ {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config),
+ {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config),
+ ok.
+
+init_per_tc(suite) -> [];
+init_per_tc(doc) -> ["Test that a Config that is altered in ",
+ "init_per_testcase gets through to the ",
+ "actual testcase."];
+init_per_tc(Config) ->
+ %% Check that the config var sent from init_per_testcase
+ %% really exists.
+ {value, {strange_var, 1}} = lists:keysearch(strange_var,1,Config),
+
+ %% Check that the other variables still exist.
+ {value,{data_dir,_Dd}}=lists:keysearch(data_dir,1,Config),
+ {value,{priv_dir,_Dp}}=lists:keysearch(priv_dir,1,Config),
+ ok.
+
+end_per_tc(suite) -> [];
+end_per_tc(doc) -> ["Test that end_per_testcase/2 is called even if"
+ " test case fails"];
+end_per_tc(Config) when is_list(Config) ->
+ ?t:fail("This case should fail! Check that \"CLEANUP\" is"
+ " printed in the minor log file.").
+
+
+timeconv(suite) -> [];
+timeconv(doc) -> ["Test that the time unit conversion functions ",
+ "works."];
+timeconv(Config) when is_list(Config) ->
+ Val=2,
+ Secs=Val*1000,
+ Mins=Secs*60,
+ Hrs=Mins*60,
+ Secs=?t:seconds(2),
+ Mins=?t:minutes(2),
+ Hrs=?t:hours(2),
+ ok.
+
+
+msgs(suite) -> [];
+msgs(doc) -> ["Tests the messages_get function."];
+msgs(Config) when is_list(Config) ->
+ self() ! {hej, du},
+ self() ! {lite, "data"},
+ self() ! en_atom,
+ [{hej, du}, {lite, "data"}, en_atom] = ?t:messages_get(),
+ ok.
+
+capture(suite) -> [];
+capture(doc) -> ["Test that the capture functions work properly."];
+capture(Config) when is_list(Config) ->
+ String1="abcedfghjiklmnopqrstuvwxyz",
+ String2="0123456789",
+ ?t:capture_start(),
+ io:format(String1),
+ [String1]=?t:capture_get(),
+ io:format(String2),
+ [String2]=?t:capture_get(),
+ ?t:capture_stop(),
+ []=?t:capture_get(),
+ io:format(String2),
+ []=?t:capture_get(),
+ ok.
+
+timecall(suite) -> [];
+timecall(doc) -> ["Tests that timed calls work."];
+timecall(Config) when is_list(Config) ->
+ {_Time1, liten_apa_e_oxo_farlig} = ?t:timecall(?MODULE, dummy_function, []),
+ {Time2, jag_ar_en_gorilla} = ?t:timecall(?MODULE, dummy_function, [gorilla]),
+ DTime=round(Time2),
+ if
+ DTime<1 ->
+ ?t:fail("Timecall reported a too low time.");
+ DTime==1 ->
+ ok;
+ DTime>1 ->
+ ?t:fail("Timecall reported a too high time.")
+ end,
+ ok.
+
+dummy_function() ->
+ liten_apa_e_oxo_farlig.
+dummy_function(gorilla) ->
+ receive after 1000 -> ok end,
+ jag_ar_en_gorilla.
+
+
+do_times(suite) -> [do_times_mfa, do_times_fun];
+do_times(doc) -> ["Test the do_times function."].
+
+do_times_mfa(suite) -> [];
+do_times_mfa(doc) -> ["Test the do_times function with M,F,A given."];
+do_times_mfa(Config) when is_list(Config) ->
+ ?t:do_times(100, ?MODULE, doer, [self()]),
+ 100=length(?t:messages_get()),
+ ok.
+
+do_times_fun(suite) -> [];
+do_times_fun(doc) -> ["Test the do_times function with fun given."];
+do_times_fun(Config) when is_list(Config) ->
+ Self = self(),
+ ?t:do_times(100, fun() -> doer(Self) end),
+ 100=length(?t:messages_get()),
+ ok.
+
+doer(From) ->
+ From ! a,
+ ok.
+
+skip_cases(doc) -> ["Test all possible ways to skip a test case."];
+skip_cases(suite) -> [skip_case1, skip_case2, skip_case3, skip_case4,
+ skip_case5, skip_case6, skip_case7, skip_case8,
+ skip_case9].
+
+skip_case1(suite) -> [];
+skip_case1(doc) -> ["Test that you can return {skipped, Reason},"
+ " and that Reason is in the comment field in the HTML log"];
+skip_case1(Config) when is_list(Config) ->
+ %% If this comment shows, the case failed!!
+ ?t:comment("ERROR: This case should have been noted as `Skipped'"),
+ %% The Reason in {skipped, Reason} should overwrite a 'comment'
+ {skipped, "This case should be noted as `Skipped'"}.
+
+skip_case2(suite) -> [];
+skip_case2(doc) -> ["Test that you can return {skipped, Reason},"
+ " and that Reason is in the comment field in the HTML log"];
+skip_case2(Config) when is_list(Config) ->
+ %% If this comment shows, the case failed!!
+ ?t:comment("ERROR: This case should have been noted as `Skipped'"),
+ %% The Reason in {skipped, Reason} should overwrite a 'comment'
+ exit({skipped, "This case should be noted as `Skipped'"}).
+
+skip_case3(suite) -> [];
+skip_case3(doc) -> ["Test that you can return {skip, Reason},"
+ " and that Reason is in the comment field in the HTML log"];
+skip_case3(Config) when is_list(Config) ->
+ %% If this comment shows, the case failed!!
+ ?t:comment("ERROR: This case should have been noted as `Skipped'"),
+ %% The Reason in {skip, Reason} should overwrite a 'comment'
+ {skip, "This case should be noted as `Skipped'"}.
+
+skip_case4(suite) -> [];
+skip_case4(doc) -> ["Test that you can return {skip, Reason},"
+ " and that Reason is in the comment field in the HTML log"];
+skip_case4(Config) when is_list(Config) ->
+ %% If this comment shows, the case failed!!
+ ?t:comment("ERROR: This case should have been noted as `Skipped'"),
+ %% The Reason in {skip, Reason} should overwrite a 'comment'
+ exit({skip, "This case should be noted as `Skipped'"}).
+
+skip_case5(suite) -> {skipped, "This case should be noted as `Skipped'"};
+skip_case5(doc) -> ["Test that you can return {skipped, Reason}"
+ " from the specification clause"].
+
+skip_case6(suite) -> {skip, "This case should be noted as `Skipped'"};
+skip_case6(doc) -> ["Test that you can return {skip, Reason}"
+ " from the specification clause"].
+
+skip_case7(suite) -> [];
+skip_case7(doc) -> ["Test that skip works from a test specification file"];
+skip_case7(Config) when is_list(Config) ->
+ %% This case shall be skipped by adding
+ %% {skip, {test_server_SUITE, skip_case7, Reason}}.
+ %% to the test specification file.
+ ?t:fail("This case should have been Skipped by the .spec file").
+
+skip_case8(suite) -> [];
+skip_case8(doc) -> ["Test that {skipped, Reason} works from"
+ " init_per_testcase/2"];
+skip_case8(Config) when is_list(Config) ->
+ %% This case shall be skipped by adding a specific clause to
+ %% returning {skipped, Reason} from init_per_testcase/2 for this case.
+ ?t:fail("This case should have been Skipped by init_per_testcase/2").
+
+skip_case9(suite) -> [];
+skip_case9(doc) -> ["Test that {skip, Reason} works from a init_per_testcase/2"];
+skip_case9(Config) when is_list(Config) ->
+ %% This case shall be skipped by adding a specific clause to
+ %% returning {skip, Reason} from init_per_testcase/2 for this case.
+ ?t:fail("This case should have been Skipped by init_per_testcase/2").
+
+undefined_functions(suite) -> [];
+undefined_functions(doc) -> ["Check for calls to undefined functions in"
+ " test_server."
+ "Skip if cover is running"];
+undefined_functions(Config) when is_list(Config) ->
+ case whereis(cover_server) of
+ Pid when is_pid(Pid) ->
+ {skip,"Cover is running"};
+ undefined ->
+ undefined_functions()
+ end.
+
+undefined_functions() ->
+ TestServerDir = filename:dirname(code:which(test_server)),
+ Res = xref:d(TestServerDir),
+
+ {value,{unused,Unused}} = lists:keysearch(unused, 1, Res),
+ case Unused of
+ [] -> ok;
+ _ ->
+ lists:foreach(fun (MFA) ->
+ io:format("~s unused", [format_mfa(MFA)])
+ end, Unused)
+ end,
+
+ {value,{undefined,Undef0}} = lists:keysearch(undefined, 1, Res),
+ Undef = [U || U <- Undef0, not unresolved(U)],
+ case Undef of
+ [] -> ok;
+ _ ->
+ lists:foreach(fun ({MFA1,MFA2}) ->
+ io:format("~s calls undefined ~s",
+ [format_mfa(MFA1),format_mfa(MFA2)])
+ end, Undef),
+ ?t:fail({length(Undef),undefined_functions_in_otp})
+ end,
+ ok.
+
+unresolved({_,{_,'$F_EXPR',_}}) -> true;
+unresolved(_) -> false.
+
+format_mfa({M,F,A}) ->
+ lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])).
+
+conf_init(doc) -> ["Test successful conf case: Change Config parameter"];
+conf_init(Config) when is_list(Config) ->
+ [{conf_init_var,1389}|Config].
+
+check_new_conf(suite) -> [];
+check_new_conf(doc) -> ["Check that Config parameter changed by"
+ " conf_init is used"];
+check_new_conf(Config) when is_list(Config) ->
+ 1389 = ?config(conf_init_var,Config),
+ ok.
+
+conf_cleanup(doc) -> ["Test successful conf case: Restore Config parameter"];
+conf_cleanup(Config) when is_list(Config) ->
+ lists:keydelete(conf_init_var,1,Config).
+
+check_old_conf(suite) -> [];
+check_old_conf(doc) -> ["Test that the restored Config is used after a"
+ " conf cleanup"];
+check_old_conf(Config) when is_list(Config) ->
+ undefined = ?config(conf_init_var,Config),
+ ok.
+
+conf_init_fail(doc) -> ["Test that config members are skipped if"
+ " conf init function fails."];
+conf_init_fail(Config) when is_list(Config) ->
+ ?t:fail("This case should fail! Check that conf_member_skip and"
+ " conf_cleanup_skip are skipped.").
+
+
+
+start_stop_node(suite) -> [];
+start_stop_node(doc) -> ["Test start and stop of slave and peer nodes"];
+start_stop_node(Config) when is_list(Config) ->
+ {ok,Node2} = ?t:start_node(node2,peer,[]),
+ {error, _} = ?t:start_node(node2,peer,[{fail_on_error,false}]),
+ true = lists:member(Node2,nodes()),
+
+ {ok,Node3} = ?t:start_node(node3,slave,[]),
+ {error, _} = ?t:start_node(node3,slave,[]),
+ true = lists:member(Node3,nodes()),
+
+ {ok,Node4} = ?t:start_node(node4,peer,[{wait,false}]),
+ case lists:member(Node4,nodes()) of
+ true ->
+ ?t:comment("WARNING: Node started with {wait,false}"
+ " is up faster than expected...");
+ false ->
+ wait_for_node(Node4,0),
+ true = lists:member(Node4,nodes())
+ end,
+
+ true = ?t:stop_node(Node2),
+ false = lists:member(Node2,nodes()),
+
+ true = ?t:stop_node(Node3),
+ false = lists:member(Node3,nodes()),
+
+ true = ?t:stop_node(Node4),
+ false = lists:member(Node4,nodes()),
+ timer:sleep(2000),
+ false = ?t:stop_node(Node4),
+
+ ok.
+
+
+wait_for_node(Node,Acc) ->
+ case net_adm:ping(Node) of
+ pang ->
+ timer:sleep(100),
+ wait_for_node(Node,Acc+100);
+ pong ->
+ Acc
+ end.
+
+cleanup_nodes_init(doc) -> ["Test that nodes are terminated when test case"
+ " is finished unless {cleanup,false} is given."];
+cleanup_nodes_init(Config) when is_list(Config) ->
+ {ok,DieSlave} = ?t:start_node(die_slave, slave, []),
+ {ok,SurviveSlave} = ?t:start_node(survive_slave, slave, [{cleanup,false}]),
+ {ok,DiePeer} = ?t:start_node(die_peer, peer, []),
+ {ok,SurvivePeer} = ?t:start_node(survive_peer, peer, [{cleanup,false}]),
+ [{die_slave,DieSlave},
+ {survive_slave,SurviveSlave},
+ {die_peer,DiePeer},
+ {survive_peer,SurvivePeer} | Config].
+
+
+
+check_survive_nodes(suite) -> [];
+check_survive_nodes(doc) -> ["Test that nodes with {cleanup,false} survived"];
+check_survive_nodes(Config) when is_list(Config) ->
+ timer:sleep(1000),
+ false = lists:member(?config(die_slave,Config),nodes()),
+ true = lists:member(?config(survive_slave,Config),nodes()),
+ false = lists:member(?config(die_peer,Config),nodes()),
+ true = lists:member(?config(survive_peer,Config),nodes()),
+ ok.
+
+
+cleanup_nodes_fin(doc) -> ["Test that nodes started with {cleanup,false}"
+ " can be stopped"];
+cleanup_nodes_fin(Config) when is_list(Config) ->
+ Slave = ?config(survive_slave,Config),
+ Peer = ?config(survive_peer,Config),
+
+ true = ?t:stop_node(Slave),
+ false = lists:member(Slave,nodes()),
+ true = ?t:stop_node(Peer),
+ false = lists:member(Peer,nodes()),
+
+ C1 = lists:keydelete(die_slave,1,Config),
+ C2 = lists:keydelete(survive_slave,1,C1),
+ C3 = lists:keydelete(die_peer,1,C2),
+ lists:keydelete(survive_peer,1,C3).
+
+commercial(Config) when is_list(Config) ->
+ case ?t:is_commercial() of
+ false -> {comment,"Open-source build"};
+ true -> {comment,"Commercial build"}
+ end.
+
+
diff --git a/lib/test_server/test/test_server_SUITE_data/dummy_file b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file
index 65c88fbd75..65c88fbd75 100644
--- a/lib/test_server/test/test_server_SUITE_data/dummy_file
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_SUITE_data/dummy_file
diff --git a/lib/test_server/test/test_server_conf01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl
index a6d7dfe851..a6d7dfe851 100644
--- a/lib/test_server/test/test_server_conf01_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf01_SUITE.erl
diff --git a/lib/test_server/test/test_server_conf02_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl
index deba4660c6..deba4660c6 100644
--- a/lib/test_server/test/test_server_conf02_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_conf02_SUITE.erl
diff --git a/lib/test_server/test/test_server_parallel01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl
index 0e7f329f89..0e7f329f89 100644
--- a/lib/test_server/test/test_server_parallel01_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_parallel01_SUITE.erl
diff --git a/lib/test_server/test/test_server_shuffle01_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl
index 7ad269501d..7ad269501d 100644
--- a/lib/test_server/test/test_server_shuffle01_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_shuffle01_SUITE.erl
diff --git a/lib/test_server/test/test_server_skip_SUITE.erl b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl
index 4037e1cc0e..4037e1cc0e 100644
--- a/lib/test_server/test/test_server_skip_SUITE.erl
+++ b/lib/test_server/test/test_server_SUITE_data/test_server_skip_SUITE.erl
diff --git a/lib/test_server/test/test_server_line_SUITE.erl b/lib/test_server/test/test_server_line_SUITE.erl
index 02897f164f..aa14862e5a 100644
--- a/lib/test_server/test/test_server_line_SUITE.erl
+++ b/lib/test_server/test/test_server_line_SUITE.erl
@@ -23,20 +23,29 @@
-module(test_server_line_SUITE).
-include_lib("test_server/include/test_server.hrl").
--export([all/1]).
--export([init_per_testcase/2, fin_per_testcase/2]).
+-export([all/0,suite/0]).
+-export([init_per_suite/1,end_per_suite/1,
+ init_per_testcase/2, end_per_testcase/2]).
-export([parse_transform/1, lines/1]).
-all(doc) -> ["Test of parse transform for collection line numbers"];
-all(suite) -> [parse_transform,lines].
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {doc,["Test of parse transform for collection line numbers"]}].
+all() -> [parse_transform,lines].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
init_per_testcase(_Case, Config) ->
?line test_server_line:clear(),
Dog = ?t:timetrap(?t:minutes(2)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
?line test_server_line:clear(),
Dog=?config(watchdog, Config),
?t:timetrap_cancel(Dog),
diff --git a/lib/test_server/test/test_server_test_lib.erl b/lib/test_server/test/test_server_test_lib.erl
new file mode 100644
index 0000000000..66ff06e0ce
--- /dev/null
+++ b/lib/test_server/test/test_server_test_lib.erl
@@ -0,0 +1,191 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2009-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(test_server_test_lib).
+-export([parse_suite/1]).
+-export([init/2, pre_init_per_testcase/3, post_end_per_testcase/4]).
+
+-include("test_server_test_lib.hrl").
+
+%% The CTH hooks all tests
+init(_Id, _Opts) ->
+ [].
+
+pre_init_per_testcase(_TC,Config,State) ->
+ case os:type() of
+ {win32, _} ->
+ %% Extend timeout for windows as starting node
+ %% can take a long time there
+ test_server:timetrap( 120000 * test_server:timetrap_scale_factor());
+ _ ->
+ ok
+ end,
+ {start_slave(Config, 50),State}.
+
+start_slave(Config,_Level) ->
+ [_,Host] = string:tokens(atom_to_list(node()), "@"),
+
+ ct:log("Trying to start ~s~n",
+ ["test_server_tester@"++Host]),
+ case slave:start(Host, test_server_tester, []) of
+ {error,Reason} ->
+ test_server:fail(Reason);
+ {ok,Node} ->
+ ct:log("Node ~p started~n", [Node]),
+ IsCover = test_server:is_cover(),
+ if IsCover ->
+ cover:start(Node);
+ true->
+ ok
+ end,
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+
+ %% PrivDir as well as directory of Test Server suites
+ %% have to be in code path on Test Server node.
+ [_ | Parts] = lists:reverse(filename:split(DataDir)),
+ TSDir = filename:join(lists:reverse(Parts)),
+ AddPathDirs = case proplists:get_value(path_dirs, Config) of
+ undefined -> [];
+ Ds -> Ds
+ end,
+ PathDirs = [PrivDir,TSDir | AddPathDirs],
+ [true = rpc:call(Node, code, add_patha, [D]) || D <- PathDirs],
+ io:format("Dirs added to code path (on ~w):~n",
+ [Node]),
+ [io:format("~s~n", [D]) || D <- PathDirs],
+
+ true = rpc:call(Node, os, putenv,
+ ["TEST_SERVER_FRAMEWORK", "undefined"]),
+
+ ok = rpc:call(Node, file, set_cwd, [PrivDir]),
+ [{node,Node} | Config]
+ end.
+
+post_end_per_testcase(_TC, Config, Return, State) ->
+ Node = proplists:get_value(node, Config),
+ cover:stop(Node),
+ slave:stop(Node),
+
+ {Return, State}.
+
+%% Parse an .suite log file
+parse_suite(FileName) ->
+
+ case file:open(FileName, [read, raw, read_ahead]) of
+ {ok, Fd} ->
+ Data = parse_suite(Fd, #suite{ }),
+ file:close(Fd),
+ {ok, Data};
+ _ ->
+ error
+ end.
+
+fline(Fd) ->
+ case prim_file:read_line(Fd) of
+ eof -> eof;
+ {ok, Line} -> Line
+ end.
+
+parse_suite(Fd, S) ->
+ _Started = fline(Fd),
+ _Starting = fline(Fd),
+ "=cases" ++ NCases = fline(Fd),
+ "=user" ++ _User = fline(Fd),
+ "=host" ++ Host = fline(Fd),
+ "=hosts" ++ _Hosts = fline(Fd),
+ "=emulator_vsn" ++ Evsn = fline(Fd),
+ "=emulator" ++ Emu = fline(Fd),
+ "=otp_release" ++ OtpRel = fline(Fd),
+ "=started" ++ Start = fline(Fd),
+ NewS = parse_cases(Fd, S#suite{
+ n_cases_expected = list_to_int(clean(NCases)),
+ host = list_to_binary(clean(Host)),
+ emulator_vsn = list_to_binary(clean(Evsn)),
+ emulator = list_to_binary(clean(Emu)),
+ otp_release = list_to_binary(clean(OtpRel)),
+ started = list_to_binary(clean(Start))
+ }),
+ "=failed" ++ Failed = fline(Fd),
+ "=successful" ++ Succ = fline(Fd),
+ "=user_skipped" ++ UsrSkip = fline(Fd),
+ "=auto_skipped" ++ AutSkip = fline(Fd),
+ NewS#suite{ n_cases_failed = list_to_int(clean(Failed)),
+ n_cases_succ = list_to_int(clean(Succ)),
+ n_cases_user_skip = list_to_int(clean(UsrSkip)),
+ n_cases_auto_skip = list_to_int(clean(AutSkip)) }.
+
+
+parse_cases(Fd, #suite{ n_cases = N,
+ cases = Cases } = S) ->
+ case parse_case(Fd) of
+ finished -> S#suite{ log_ok = true };
+ {eof, Tc} ->
+ S#suite{ n_cases = N + 1,
+ cases = [Tc#tc{ result = crashed }|Cases]};
+ {ok, Case} ->
+ parse_cases(Fd, S#suite{ n_cases = N + 1,
+ cases = [Case|Cases]})
+ end.
+
+parse_case(Fd) -> parse_case(Fd, #tc{}).
+parse_case(Fd, Tc) -> parse_case(fline(Fd), Fd, Tc).
+
+parse_case(eof, _, Tc) -> {eof, Tc};
+parse_case("=case" ++ Case, Fd, Tc) ->
+ Name = list_to_binary(clean(Case)),
+ parse_case(fline(Fd), Fd, Tc#tc{ name = Name });
+parse_case("=logfile" ++ File, Fd, Tc) ->
+ Log = list_to_binary(clean(File)),
+ parse_case(fline(Fd), Fd, Tc#tc{ logfile = Log });
+parse_case("=elapsed" ++ Elapsed, Fd, Tc) ->
+ {ok, [Time], _} = io_lib:fread("~f", clean(Elapsed)),
+ parse_case(fline(Fd), Fd, Tc#tc{ elapsed = Time });
+parse_case("=result" ++ Result, _, Tc) ->
+ case clean(Result) of
+ "ok" ++ _ ->
+ {ok, Tc#tc{ result = ok } };
+ "failed" ++ _ ->
+ {ok, Tc#tc{ result = failed } };
+ "skipped" ++ _ ->
+ {ok, Tc#tc{ result = skip } }
+ end;
+parse_case("=finished" ++ _ , _Fd, #tc{ name = undefined }) ->
+ finished;
+parse_case(_, Fd, Tc) ->
+ parse_case(fline(Fd), Fd, Tc).
+
+skip([]) -> [];
+skip([$ |Ts]) -> skip(Ts);
+skip(Ts) -> Ts.
+
+%rmnl(L) -> L.
+rmnl([]) -> [];
+rmnl([$\n | Ts]) -> rmnl(Ts);
+rmnl([T|Ts]) -> [T | rmnl(Ts)].
+
+clean(L) ->
+ rmnl(skip(L)).
+
+list_to_int(L) ->
+ try
+ list_to_integer(L)
+ catch
+ _:_ ->
+ 0
+ end.
diff --git a/lib/test_server/test/test_server_test_lib.hrl b/lib/test_server/test/test_server_test_lib.hrl
new file mode 100644
index 0000000000..27b7be9618
--- /dev/null
+++ b/lib/test_server/test/test_server_test_lib.hrl
@@ -0,0 +1,23 @@
+-record(tc, {
+ name,
+ result,
+ elapsed,
+ logfile
+ }).
+
+-record(suite, {
+ application,
+ n_cases = 0,
+ n_cases_failed = 0,
+ n_cases_expected = 0,
+ n_cases_succ,
+ n_cases_user_skip,
+ n_cases_auto_skip,
+ cases = [],
+ host,
+ emulator_vsn,
+ emulator,
+ otp_release,
+ started,
+ log_ok = false
+ }).