aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/test')
-rw-r--r--lib/stdlib/test/Makefile2
-rw-r--r--lib/stdlib/test/digraph_utils_SUITE.erl5
-rw-r--r--lib/stdlib/test/dummy_via.erl94
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl8
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl25
-rw-r--r--lib/stdlib/test/erl_expand_records_SUITE.erl12
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl30
-rw-r--r--lib/stdlib/test/ets_SUITE.erl34
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl26
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl71
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl62
-rw-r--r--lib/stdlib/test/io_proto_SUITE.erl2
-rw-r--r--lib/stdlib/test/ms_transform_SUITE.erl5
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl22
-rw-r--r--lib/stdlib/test/re_SUITE.erl54
-rw-r--r--lib/stdlib/test/shell_SUITE.erl29
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl64
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl122
-rw-r--r--lib/stdlib/test/supervisor_deadlock.erl45
19 files changed, 593 insertions, 119 deletions
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index aa6a660c34..4de6ea3ee7 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -20,6 +20,7 @@ MODULES= \
digraph_utils_SUITE \
dummy1_h \
dummy_h \
+ dummy_via \
edlin_expand_SUITE \
epp_SUITE \
erl_eval_helper \
@@ -66,6 +67,7 @@ MODULES= \
string_SUITE \
supervisor_1 \
supervisor_2 \
+ supervisor_deadlock \
naughty_child \
shell_SUITE \
supervisor_SUITE \
diff --git a/lib/stdlib/test/digraph_utils_SUITE.erl b/lib/stdlib/test/digraph_utils_SUITE.erl
index 12c486c25f..6b554c2fb7 100644
--- a/lib/stdlib/test/digraph_utils_SUITE.erl
+++ b/lib/stdlib/test/digraph_utils_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2012. 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
@@ -211,8 +211,7 @@ condensation(Config) when is_list(Config) ->
{lists:sort(V1), lists:sort(V2)}
end,
?line Es = lists:map(Fun, digraph:edges(CG)),
- ?line [{[b],[c]},{[b],[d]},{[e,f,g],[e,f,g]},{[h],[h]},{[i,j],[i,j]}] =
- lists:sort(Es),
+ ?line [{[b],[c]},{[b],[d]}] = lists:sort(Es),
?line true = digraph:delete(CG),
?line true = digraph:delete(G),
ok.
diff --git a/lib/stdlib/test/dummy_via.erl b/lib/stdlib/test/dummy_via.erl
new file mode 100644
index 0000000000..e405811cbe
--- /dev/null
+++ b/lib/stdlib/test/dummy_via.erl
@@ -0,0 +1,94 @@
+-module(dummy_via).
+-export([reset/0,
+ register_name/2,
+ whereis_name/1,
+ unregister_name/1,
+ send/2]).
+
+
+reset() ->
+ P = whereis(?MODULE),
+ catch unlink(P),
+ Ref = erlang:monitor(process, P),
+ catch exit(P, kill),
+ receive {'DOWN',Ref,_,_,_} -> ok end,
+ Me = self(),
+ Pid = spawn_link(fun() ->
+ register(?MODULE, self()),
+ Me ! {self(), started},
+ loop([])
+ end),
+ receive
+ {Pid, started} ->
+ Pid
+ after 10000 ->
+ exit(timeout)
+ end.
+
+register_name(Name, Pid) when is_pid(Pid) ->
+ call({register_name, Name, Pid}).
+
+unregister_name(Name) ->
+ call({unregister_name, Name}).
+
+whereis_name(Name) ->
+ call({whereis_name, Name}).
+
+send(Name, Msg) ->
+ case whereis_name(Name) of
+ undefined ->
+ exit({badarg, {Name, Msg}});
+ Pid when is_pid(Pid) ->
+ Pid ! Msg,
+ Pid
+ end.
+
+call(Req) ->
+ MRef = erlang:monitor(process, ?MODULE),
+ ?MODULE ! {self(), MRef, Req},
+ receive
+ {'DOWN', MRef, _, _, _} ->
+ erlang:error(badarg);
+ {MRef, badarg} ->
+ erlang:error(badarg);
+ {MRef, Reply} ->
+ Reply
+ after 5000 ->
+ erlang:error(timeout)
+ end.
+
+loop(Reg) ->
+ receive
+ {'DOWN', _, _, P, _} when is_pid(P) ->
+ loop([X || {_,Pid,_} = X <- Reg, Pid =/= P]);
+ {From, Ref, Request} when is_pid(From), is_reference(Ref) ->
+ {Reply, NewReg} = handle_request(Request, Reg),
+ From ! {Ref, Reply},
+ loop(NewReg)
+ end.
+
+handle_request({register_name, Name, Pid}, Reg) when is_pid(Pid) ->
+ case lists:keyfind(Name, 1, Reg) of
+ false ->
+ Ref = erlang:monitor(process, Pid),
+ {yes, [{Name, Pid, Ref}|Reg]};
+ _ ->
+ {no, Reg}
+ end;
+handle_request({whereis_name, Name}, Reg) ->
+ case lists:keyfind(Name, 1, Reg) of
+ {_, Pid, _} ->
+ {Pid, Reg};
+ false ->
+ {undefined, Reg}
+ end;
+handle_request({unregister_name, Name}, Reg) ->
+ case lists:keyfind(Name, 1, Reg) of
+ {_, _, Ref} ->
+ catch erlang:demonitor(Ref);
+ _ ->
+ ok
+ end,
+ {ok, lists:keydelete(Name, 1, Reg)};
+handle_request(_, Reg) ->
+ {badarg, Reg}.
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index a0e198ce09..f8d4fb4b6a 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -46,10 +46,10 @@ groups() ->
[].
init_per_suite(Config) ->
- true = code:delete(expand_test),
- true = code:delete(expand_test1),
- true = code:delete('ExpandTestCaps'),
- true = code:delete('ExpandTestCaps1'),
+ (catch code:delete(expand_test)),
+ (catch code:delete(expand_test1)),
+ (catch code:delete('ExpandTestCaps')),
+ (catch code:delete('ExpandTestCaps1')),
Config.
end_per_suite(_Config) ->
diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl
index 369d8b224e..ca2f18a05a 100644
--- a/lib/stdlib/test/erl_eval_SUITE.erl
+++ b/lib/stdlib/test/erl_eval_SUITE.erl
@@ -1167,15 +1167,22 @@ do_funs(LFH, EFH) ->
[[[0]]], ['F'], LFH, EFH),
%% Tests for a bug found by the Dialyzer - used to crash.
- ?line check(fun() -> Pmod = erl_eval_helper:new(42), Pmod:add(5) end,
- "begin Pmod = erl_eval_helper:new(42), Pmod:add(5) end.",
- 47,
- ['Pmod'], LFH, EFH),
- ?line check(fun() -> Pmod = erl_eval_helper:new(42), B = Pmod:add(7), B end,
- "begin Pmod = erl_eval_helper:new(42), B = Pmod:add(7), B end.",
- 49,
- ['B','Pmod'], LFH, EFH),
-
+ case test_server:is_native(erl_eval) of
+ true ->
+ %% Parameterized modules are not supported by HiPE.
+ ok;
+ false ->
+ check(fun() -> Pmod = erl_eval_helper:new(42), Pmod:add(5) end,
+ "begin Pmod = erl_eval_helper:new(42), Pmod:add(5) end.",
+ 47,
+ ['Pmod'], LFH, EFH),
+ check(fun() -> Pmod = erl_eval_helper:new(42),
+ B = Pmod:add(7), B end,
+ "begin Pmod = erl_eval_helper:new(42), "
+ "B = Pmod:add(7), B end.",
+ 49,
+ ['B','Pmod'], LFH, EFH)
+ end,
ok.
count_down(F, N) when N > 0 ->
diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl
index f8c1ad783c..8b162cfda0 100644
--- a/lib/stdlib/test/erl_expand_records_SUITE.erl
+++ b/lib/stdlib/test/erl_expand_records_SUITE.erl
@@ -178,6 +178,9 @@ expr(Config) when is_list(Config) ->
true ->
not_ok
end.
+
+ is_record(_, _, _) ->
+ error(wrong_is_record).
">>
],
@@ -366,6 +369,8 @@ strict(Config) when is_list(Config) ->
end
catch error:_ -> ok
end.
+ element(_, _) ->
+ error(wrong_element).
">>
],
?line run(Config, Ts1, [strict_record_tests]),
@@ -380,6 +385,8 @@ strict(Config) when is_list(Config) ->
case foo of
_ when A#r2.a =:= 1 -> ok
end.
+ element(_, _) ->
+ error(wrong_element).
">>
],
?line run(Config, Ts2, [no_strict_record_tests]),
@@ -415,6 +422,11 @@ update(Config) when is_list(Config) ->
t2() ->
R0 = #r{},
#r{_ = R0#r{a = ok}}.
+
+ %% Implicit calls to setelement/3 must go to the BIF,
+ %% not to this function.
+ setelement(_, _, _) ->
+ erlang:error(wrong_setelement_called).
">>
],
?line run(Config, Ts),
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 9041adbe5c..4e93f056ad 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -2631,7 +2631,35 @@ bif_clash(Config) when is_list(Config) ->
binary_part(A,B,C).
">>,
[warn_unused_import],
- {warnings,[{2,erl_lint,{redefine_bif_import,{binary_part,3}}}]}}
+ {warnings,[{2,erl_lint,{redefine_bif_import,{binary_part,3}}}]}},
+ %% Don't accept call to a guard BIF if there is a local definition
+ %% or an import with the same name. Note: is_record/2 is an
+ %% exception, since it is more of syntatic sugar than a real BIF.
+ {clash21,
+ <<"-export([is_list/1]).
+ -import(x, [is_tuple/1]).
+ -record(r, {a,b}).
+ x(T) when is_tuple(T) -> ok;
+ x(T) when is_list(T) -> ok.
+ y(T) when is_tuple(T) =:= true -> ok;
+ y(T) when is_list(T) =:= true -> ok;
+ y(T) when is_record(T, r, 3) -> ok;
+ y(T) when is_record(T, r, 3) =:= true -> ok;
+ y(T) when is_record(T, r) =:= true -> ok.
+ is_list(_) ->
+ ok.
+ is_record(_, _) ->
+ ok.
+ is_record(_, _, _) ->
+ ok.
+ ">>,
+ [{no_auto_import,[{is_tuple,1}]}],
+ {errors,[{4,erl_lint,{illegal_guard_local_call,{is_tuple,1}}},
+ {5,erl_lint,{illegal_guard_local_call,{is_list,1}}},
+ {6,erl_lint,{illegal_guard_local_call,{is_tuple,1}}},
+ {7,erl_lint,{illegal_guard_local_call,{is_list,1}}},
+ {8,erl_lint,{illegal_guard_local_call,{is_record,3}}},
+ {9,erl_lint,{illegal_guard_local_call,{is_record,3}}}],[]}}
],
?line [] = run(Config, Ts),
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 0e8849b5b3..59532b65a0 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -72,9 +72,10 @@
exit_many_many_tables_owner/1]).
-export([write_concurrency/1, heir/1, give_away/1, setopts/1]).
-export([bad_table/1, types/1]).
+-export([otp_9932/1]).
-export([otp_9423/1]).
--export([init_per_testcase/2]).
+-export([init_per_testcase/2, end_per_testcase/2]).
%% Convenience for manual testing
-export([random_test/0]).
@@ -145,6 +146,7 @@ all() ->
exit_many_large_table_owner, exit_many_tables_owner,
exit_many_many_tables_owner, write_concurrency, heir,
give_away, setopts, bad_table, types,
+ otp_9932,
otp_9423].
groups() ->
@@ -2385,6 +2387,8 @@ setopts_do(Opts) ->
?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,{protection,private,false})),
?line {'EXIT',{badarg,_}} = (catch ets:setopts(T,protection)),
?line ets:delete(T),
+ unlink(Heir),
+ exit(Heir, bang),
ok.
bad_table(doc) -> ["All kinds of operations with bad table argument"];
@@ -5432,6 +5436,22 @@ types_do(Opts) ->
?line verify_etsmem(EtsMem).
+%% OTP-9932: Memory overwrite when inserting large integers in compressed bag.
+%% Will crash with segv on 64-bit opt if not fixed.
+otp_9932(Config) when is_list(Config) ->
+ T = ets:new(xxx, [bag, compressed]),
+ Fun = fun(N) ->
+ Key = {1316110174588445 bsl N,1316110174588583 bsl N},
+ S = {Key, Key},
+ true = ets:insert(T, S),
+ [S] = ets:lookup(T, Key),
+ true = ets:insert(T, S),
+ [S] = ets:lookup(T, Key)
+ end,
+ lists:foreach(Fun, lists:seq(0, 16)),
+ ets:delete(T).
+
+
otp_9423(doc) -> ["vm-deadlock caused by race between ets:delete and others on write_concurrency table"];
otp_9423(Config) when is_list(Config) ->
InitF = fun(_) -> {0,0} end,
@@ -5645,7 +5665,8 @@ spawn_logger(Procs) ->
true -> exit(Proc, kill);
_ -> ok
end,
- erlang:display(process_info(Proc)),
+ erlang:display({"Waiting for 'DOWN' from", Proc,
+ process_info(Proc), pid_status(Proc)}),
receive
{'DOWN', Mon, _, _, _} ->
ok
@@ -5656,6 +5677,15 @@ spawn_logger(Procs) ->
spawn_logger([From])
end.
+pid_status(Pid) ->
+ try
+ erts_debug:get_internal_state({process_status, Pid})
+ catch
+ error:undef ->
+ erts_debug:set_internal_state(available_internal_state, true),
+ pid_status(Pid)
+ end.
+
start_spawn_logger() ->
case whereis(ets_test_spawn_logger) of
Pid when is_pid(Pid) -> true;
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index b3a7edc140..5c51e12e35 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -62,6 +62,8 @@ start(suite) -> [];
start(Config) when is_list(Config) ->
OldFl = process_flag(trap_exit, true),
+ ?line dummy_via:reset(),
+
?line {ok, Pid0} = gen_event:start(), %anonymous
?line [] = gen_event:which_handlers(Pid0),
?line ok = gen_event:stop(Pid0),
@@ -85,6 +87,11 @@ start(Config) when is_list(Config) ->
?line [] = gen_event:which_handlers(Pid4),
?line ok = gen_event:stop({global, my_dummy_name}),
+ ?line {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}),
+ ?line [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}),
+ ?line [] = gen_event:which_handlers(Pid5),
+ ?line ok = gen_event:stop({via, dummy_via, my_dummy_name}),
+
?line {ok, _} = gen_event:start_link({local, my_dummy_name}),
?line {error, {already_started, _}} =
gen_event:start_link({local, my_dummy_name}),
@@ -92,15 +99,28 @@ start(Config) when is_list(Config) ->
gen_event:start({local, my_dummy_name}),
?line ok = gen_event:stop(my_dummy_name),
- ?line {ok, Pid5} = gen_event:start_link({global, my_dummy_name}),
+ ?line {ok, Pid6} = gen_event:start_link({global, my_dummy_name}),
?line {error, {already_started, _}} =
gen_event:start_link({global, my_dummy_name}),
?line {error, {already_started, _}} =
gen_event:start({global, my_dummy_name}),
- exit(Pid5, shutdown),
+ exit(Pid6, shutdown),
+ receive
+ {'EXIT', Pid6, shutdown} -> ok
+ after 10000 ->
+ ?t:fail(exit_gen_event)
+ end,
+
+ ?line {ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}),
+ ?line {error, {already_started, _}} =
+ gen_event:start_link({via, dummy_via, my_dummy_name}),
+ ?line {error, {already_started, _}} =
+ gen_event:start({via, dummy_via, my_dummy_name}),
+
+ exit(Pid7, shutdown),
receive
- {'EXIT', Pid5, shutdown} -> ok
+ {'EXIT', Pid7, shutdown} -> ok
after 10000 ->
?t:fail(exit_gen_event)
end,
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index d60629d841..bdb4ea65b5 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -21,11 +21,11 @@
-include_lib("test_server/include/test_server.hrl").
%% Test cases
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
--export([ start1/1, start2/1, start3/1, start4/1 , start5/1, start6/1,
- start7/1, start8/1, start9/1, start10/1, start11/1]).
+-export([start1/1, start2/1, start3/1, start4/1, start5/1, start6/1,
+ start7/1, start8/1, start9/1, start10/1, start11/1, start12/1]).
-export([ abnormal1/1, abnormal2/1]).
@@ -56,14 +56,14 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[{group, start}, {group, abnormal}, shutdown,
{group, sys}, hibernate, enter_loop].
-groups() ->
+groups() ->
[{start, [],
[start1, start2, start3, start4, start5, start6, start7,
- start8, start9, start10, start11]},
+ start8, start9, start10, start11, start12]},
{abnormal, [], [abnormal1, abnormal2]},
{sys, [],
[sys1, call_format_status, error_format_status]}].
@@ -258,6 +258,25 @@ start11(Config) when is_list(Config) ->
test_server:messages_get(),
ok.
+%% Via register linked
+start12(Config) when is_list(Config) ->
+ ?line dummy_via:reset(),
+ ?line {ok, Pid} =
+ gen_fsm:start_link({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
+ ?line {error, {already_started, Pid}} =
+ gen_fsm:start_link({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
+ ?line {error, {already_started, Pid}} =
+ gen_fsm:start({via, dummy_via, my_fsm}, gen_fsm_SUITE, [], []),
+
+ ?line ok = do_func_test(Pid),
+ ?line ok = do_sync_func_test(Pid),
+ ?line ok = do_func_test({via, dummy_via, my_fsm}),
+ ?line ok = do_sync_func_test({via, dummy_via, my_fsm}),
+ ?line stop_it({via, dummy_via, my_fsm}),
+
+ test_server:messages_get(),
+ ok.
+
%% Check that time outs in calls work
abnormal1(suite) -> [];
@@ -362,7 +381,25 @@ call_format_status(Config) when is_list(Config) ->
?line Status4 = sys:get_status(GlobalName2),
?line {status, Pid4, _Mod, [_PDict4, running, _, _, Data4]} = Status4,
?line [format_status_called | _] = lists:reverse(Data4),
- ?line stop_it(Pid4).
+ ?line stop_it(Pid4),
+
+ %% check that format_status can handle a name being a term other than a
+ %% pid or atom
+ ?line dummy_via:reset(),
+ ViaName1 = {via, dummy_via, "CallFormatStatus"},
+ ?line {ok, Pid5} = gen_fsm:start(ViaName1, gen_fsm_SUITE, [], []),
+ ?line Status5 = sys:get_status(ViaName1),
+ ?line {status, Pid5, _Mod, [_PDict5, running, _, _, Data5]} = Status5,
+ ?line [format_status_called | _] = lists:reverse(Data5),
+ ?line stop_it(Pid5),
+ ViaName2 = {via, dummy_via, {name, "term"}},
+ ?line {ok, Pid6} = gen_fsm:start(ViaName2, gen_fsm_SUITE, [], []),
+ ?line Status6 = sys:get_status(ViaName2),
+ ?line {status, Pid6, _Mod, [_PDict6, running, _, _, Data6]} = Status6,
+ ?line [format_status_called | _] = lists:reverse(Data6),
+ ?line stop_it(Pid6).
+
+
error_format_status(Config) when is_list(Config) ->
?line error_logger_forwarder:register(),
@@ -520,6 +557,8 @@ enter_loop(doc) ->
enter_loop(Config) when is_list(Config) ->
OldFlag = process_flag(trap_exit, true),
+ ?line dummy_via:reset(),
+
%% Locally registered process + {local, Name}
?line {ok, Pid1a} =
proc_lib:start_link(?MODULE, enter_loop, [local, local]),
@@ -623,10 +662,22 @@ enter_loop(Config) when is_list(Config) ->
{'EXIT', Pid6b, process_not_registered_globally} ->
ok
after 1000 ->
- ?line test_server:fail(gen_server_started)
+ ?line test_server:fail(gen_fsm_started)
end,
global:unregister_name(armitage),
+ dummy_via:register_name(armitage, self()),
+ ?line {ok, Pid6c} =
+ proc_lib:start_link(?MODULE, enter_loop, [anon, via]),
+ receive
+ {'EXIT', Pid6c, {process_not_registered_via, dummy_via}} ->
+ ok
+ after 1000 ->
+ ?line test_server:fail({gen_fsm_started, process_info(self(),
+ messages)})
+ end,
+ dummy_via:unregister_name(armitage),
+
process_flag(trap_exit, OldFlag),
ok.
@@ -635,6 +686,7 @@ enter_loop(Reg1, Reg2) ->
case Reg1 of
local -> register(armitage, self());
global -> global:register_name(armitage, self());
+ via -> dummy_via:register_name(armitage, self());
anon -> ignore
end,
proc_lib:init_ack({ok, self()}),
@@ -643,6 +695,9 @@ enter_loop(Reg1, Reg2) ->
gen_fsm:enter_loop(?MODULE, [], state0, [], {local,armitage});
global ->
gen_fsm:enter_loop(?MODULE, [], state0, [], {global,armitage});
+ via ->
+ gen_fsm:enter_loop(?MODULE, [], state0, [],
+ {via, dummy_via, armitage});
anon ->
gen_fsm:enter_loop(?MODULE, [], state0, [])
end.
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 7fb8d54f2d..cdf15ba017 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -36,7 +36,7 @@
]).
% spawn export
--export([spec_init_local/2, spec_init_global/2,
+-export([spec_init_local/2, spec_init_global/2, spec_init_via/2,
spec_init_default_timeout/2, spec_init_anonymous/1,
spec_init_anonymous_default_timeout/1,
spec_init_not_proc_lib/1, cast_fast_messup/0]).
@@ -199,6 +199,35 @@ start(Config) when is_list(Config) ->
test_server:fail(not_stopped)
end,
+ %% via register
+ ?line dummy_via:reset(),
+ ?line {ok, Pid6} =
+ gen_server:start({via, dummy_via, my_test_name},
+ gen_server_SUITE, [], []),
+ ?line ok = gen_server:call({via, dummy_via, my_test_name}, started_p),
+ ?line {error, {already_started, Pid6}} =
+ gen_server:start({via, dummy_via, my_test_name},
+ gen_server_SUITE, [], []),
+ ?line ok = gen_server:call({via, dummy_via, my_test_name}, stop),
+ test_server:sleep(1),
+ ?line {'EXIT', {noproc,_}} = (catch gen_server:call(Pid6, started_p, 10)),
+
+ %% via register linked
+ ?line dummy_via:reset(),
+ ?line {ok, Pid7} =
+ gen_server:start_link({via, dummy_via, my_test_name},
+ gen_server_SUITE, [], []),
+ ?line ok = gen_server:call({via, dummy_via, my_test_name}, started_p),
+ ?line {error, {already_started, Pid7}} =
+ gen_server:start({via, dummy_via, my_test_name},
+ gen_server_SUITE, [], []),
+ ?line ok = gen_server:call({via, dummy_via, my_test_name}, stop),
+ ?line receive
+ {'EXIT', Pid7, stopped} ->
+ ok
+ after 5000 ->
+ test_server:fail(not_stopped)
+ end,
test_server:messages_get(),
%% Must wait for all error messages before going to next test.
@@ -853,6 +882,8 @@ otp_5854(doc) ->
otp_5854(Config) when is_list(Config) ->
OldFlag = process_flag(trap_exit, true),
+ ?line dummy_via:reset(),
+
%% Make sure gen_server:enter_loop does not accept {local,Name}
%% when it's another process than the calling one which is
%% registered under that name
@@ -881,6 +912,18 @@ otp_5854(Config) when is_list(Config) ->
end,
global:unregister_name(armitage),
+ %% (same for {via, Mod, Name})
+ dummy_via:register_name(armitage, self()),
+ ?line {ok, Pid3} =
+ start_link(spec_init_via, [{not_ok, armitage}, []]),
+ receive
+ {'EXIT', Pid3, {process_not_registered_via, dummy_via}} ->
+ ok
+ after 1000 ->
+ ?line test_server:fail(gen_server_started)
+ end,
+ dummy_via:unregister_name(armitage),
+
process_flag(trap_exit, OldFlag),
ok.
@@ -1060,7 +1103,22 @@ spec_init_global({not_ok, Name}, Options) ->
%% Supervised init can occur here ...
gen_server:enter_loop(?MODULE, Options, {}, {global, Name}, infinity).
-spec_init_default_timeout({ok, Name}, Options) ->
+spec_init_via({ok, Name}, Options) ->
+ process_flag(trap_exit, true),
+ dummy_via:register_name(Name, self()),
+ proc_lib:init_ack({ok, self()}),
+ %% Supervised init can occur here ...
+ gen_server:enter_loop(?MODULE, Options, {},
+ {via, dummy_via, Name}, infinity);
+
+spec_init_via({not_ok, Name}, Options) ->
+ process_flag(trap_exit, true),
+ proc_lib:init_ack({ok, self()}),
+ %% Supervised init can occur here ...
+ gen_server:enter_loop(?MODULE, Options, {},
+ {via, dummy_via, Name}, infinity).
+
+spec_init_default_timeout({ok, Name}, Options) ->
process_flag(trap_exit, true),
register(Name, self()),
proc_lib:init_ack({ok, self()}),
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index b69cd74edb..0b74d04b85 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -50,7 +50,7 @@
-define(privdir(Conf), ?config(priv_dir, Conf)).
-endif.
--define(debug, true).
+%%-define(debug, true).
-ifdef(debug).
-define(format(S, A), io:format(S, A)).
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index c9688354b1..a17307b07b 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -455,7 +455,6 @@ old_guards(Config) when is_list(Config) ->
?line setup(Config),
Tests = [
{atom,is_atom},
- {constant,is_constant},
{float,is_float},
{integer,is_integer},
{list,is_list},
@@ -490,7 +489,6 @@ old_guards(Config) when is_list(Config) ->
?line [{'$1',[{is_integer,'$1'},
{is_float,'$1'},
{is_atom,'$1'},
- {is_constant,'$1'},
{is_list,'$1'},
{is_number,'$1'},
{is_pid,'$1'},
@@ -502,7 +500,7 @@ old_guards(Config) when is_list(Config) ->
[true]}] =
compile_and_run(RD, <<
"ets:fun2ms(fun(X) when integer(X),"
- "float(X), atom(X), constant(X),"
+ "float(X), atom(X),"
"list(X), number(X), pid(X),"
"port(X), reference(X), tuple(X),"
"binary(X), record(X,a) -> true end)"
@@ -530,7 +528,6 @@ autoimported(Config) when is_list(Config) ->
{self,0},
%{float,1}, see float_1_function/1
{is_atom,1},
- {is_constant,1},
{is_float,1},
{is_integer,1},
{is_list,1},
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 50a76cdfb5..1e74ad7727 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2012. 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
@@ -7927,15 +7927,23 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) ->
ok
end,
+ wait_for_expected(R, Before, SourceFile, true),
+ code:purge(Mod);
+run_test(Config, Extra, Body) ->
+ run_test(Config, Extra, {cres,Body,[]}).
+
+wait_for_expected(R, Before, SourceFile, Wait) ->
Ms = erlang:process_info(self(),messages),
After = {get(), pps(), ets:all(), Ms},
- code:purge(Mod),
case {R, After} of
- {ok, Before} -> ok;
- _ -> expected({ok,Before}, {R,After}, SourceFile)
- end;
-run_test(Config, Extra, Body) ->
- run_test(Config, Extra, {cres,Body,[]}).
+ {ok, Before} ->
+ ok;
+ _ when Wait ->
+ timer:sleep(1000),
+ wait_for_expected(R, Before, SourceFile, false);
+ _ ->
+ expected({ok,Before}, {R,After}, SourceFile)
+ end.
unload_pt() ->
erlang:garbage_collect(), % get rid of references to qlc_pt...
diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl
index 3b2e637c84..d6d946a28f 100644
--- a/lib/stdlib/test/re_SUITE.erl
+++ b/lib/stdlib/test/re_SUITE.erl
@@ -445,9 +445,17 @@ split_specials(Config) when is_list(Config) ->
ok.
-error_handling(doc) ->
- ["Test that errors are handled correctly by the erlang code."];
-error_handling(Config) when is_list(Config) ->
+%% Test that errors are handled correctly by the erlang code.
+error_handling(_Config) ->
+ case test_server:is_native(re) of
+ true ->
+ %% Exceptions from native code look too different.
+ {skip,"re is native"};
+ false ->
+ error_handling()
+ end.
+
+error_handling() ->
% This test checks the exception tuples manufactured in the erlang
% code to hide the trapping from the user at least when it comes to errors
Dog = ?t:timetrap(?t:minutes(1)),
@@ -455,14 +463,14 @@ error_handling(Config) when is_list(Config) ->
% the trap to re:grun from grun, in the grun function clause
% that handles precompiled expressions
?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:run("apa",{1,2,3,4},[global])),
% An invalid capture list will also cause a badarg late,
% but with a non pre compiled RE, the exception should be thrown by the
% grun function clause that handles RE's compiled implicitly by
% the run/3 BIF before trapping.
?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:run("apa","p",[{capture,[1,{a}]},global])),
% And so the case of a precompiled expression together with
% a compile-option (binary and list subject):
@@ -473,88 +481,88 @@ error_handling(Config) when is_list(Config) ->
[<<"apa">>,
{re_pattern,1,0,_},
[global,unicode]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:run(<<"apa">>,RE,[global,unicode])),
?line {'EXIT',{badarg,[{re,run,
["apa",
{re_pattern,1,0,_},
[global,unicode]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:run("apa",RE,[global,unicode])),
?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[])),
?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[global])),
% The replace errors:
?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:replace("apa",{1,2,3,4},"X",[])),
?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:replace("apa",{1,2,3,4},"X",[global])),
?line {'EXIT',{badarg,[{re,replace,
["apa",
{re_pattern,1,0,_},
"X",
[unicode]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:replace("apa",RE,"X",[unicode])),
?line <<"aXa">> = iolist_to_binary(re:replace("apa","p","X",[])),
?line {'EXIT',{badarg,[{re,replace,
["apa","p","X",[{capture,all,binary}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch iolist_to_binary(re:replace("apa","p","X",
[{capture,all,binary}]))),
?line {'EXIT',{badarg,[{re,replace,
["apa","p","X",[{capture,all}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch iolist_to_binary(re:replace("apa","p","X",
[{capture,all}]))),
?line {'EXIT',{badarg,[{re,replace,
["apa","p","X",[{return,banana}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch iolist_to_binary(re:replace("apa","p","X",
[{return,banana}]))),
?line {'EXIT',{badarg,_}} = (catch re:replace("apa","(p","X",[])),
% Badarg, not compile error.
?line {'EXIT',{badarg,[{re,replace,
["apa","(p","X",[{return,banana}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch iolist_to_binary(re:replace("apa","(p","X",
[{return,banana}]))),
% And the split errors:
?line [<<"a">>,<<"a">>] = (catch re:split("apa","p",[])),
?line [<<"a">>,<<"p">>,<<"a">>] = (catch re:split("apa",RE,[])),
?line {'EXIT',{badarg,[{re,split,["apa","p",[global]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa","p",[global])),
?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa","p",[{capture,all}])),
?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]],_},
- {?MODULE, error_handling,1,_} | _]}} =
+ {?MODULE, error_handling,0,_} | _]}} =
(catch re:split("apa","p",[{capture,all,binary}])),
?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa",{1,2,3,4})),
?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa",{1,2,3,4},[])),
?line {'EXIT',{badarg,[{re,split,
["apa",
RE,
[unicode]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa",RE,[unicode])),
?line {'EXIT',{badarg,[{re,split,
["apa",
RE,
[{return,banana}]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa",RE,[{return,banana}])),
?line {'EXIT',{badarg,[{re,split,
["apa",
RE,
[banana]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa",RE,[banana])),
?line {'EXIT',{badarg,_}} = (catch re:split("apa","(p")),
%Exception on bad argument, not compilation error
@@ -562,7 +570,7 @@ error_handling(Config) when is_list(Config) ->
["apa",
"(p",
[banana]],_},
- {?MODULE,error_handling,1,_} | _]}} =
+ {?MODULE,error_handling,0,_} | _]}} =
(catch re:split("apa","(p",[banana])),
?t:timetrap_cancel(Dog),
ok.
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index b6019b86f0..a881742f13 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -2388,13 +2388,28 @@ otp_6554(Config) when is_list(Config) ->
comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>),
?line "exception error: no function clause matching" =
comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>),
- ?line "exception error: {function_clause," =
- comm_err(<<"erlang:error(function_clause, [unproper | list]).">>),
+ case test_server:is_native(erl_eval) of
+ true ->
+ %% Native code has different exit reason. Don't bother
+ %% testing them.
+ ok;
+ false ->
+ "exception error: {function_clause," =
+ comm_err(<<"erlang:error(function_clause, "
+ "[unproper | list]).">>),
+ %% Cheating:
+ "exception error: no function clause matching "
+ "erl_eval:do_apply(4)" ++ _ =
+ comm_err(<<"erlang:error(function_clause, [4]).">>),
+ "exception error: no function clause matching "
+ "lists:reverse(" ++ _ =
+ comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>),
+ "exception error: no function clause matching "
+ "lists:reverse(34) (lists.erl, line " ++ _ =
+ comm_err(<<"lists:reverse(34).">>)
+ end,
?line "exception error: function_clause" =
comm_err(<<"erlang:error(function_clause, 4).">>),
- %% Cheating:
- ?line "exception error: no function clause matching erl_eval:do_apply(4)" ++ _ =
- comm_err(<<"erlang:error(function_clause, [4]).">>),
?line "exception error: no function clause matching" ++ _ =
comm_err(<<"fun(a, b, c, d) -> foo end"
" (lists:seq(1,17),"
@@ -2404,10 +2419,6 @@ otp_6554(Config) when is_list(Config) ->
?line "exception error: no function clause matching" =
comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>),
- ?line "exception error: no function clause matching lists:reverse(" ++ _ =
- comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>),
- ?line "exception error: no function clause matching lists:reverse(34) (lists.erl, line " ++ _ =
- comm_err(<<"lists:reverse(34).">>),
?line "exception error: no true branch found when evaluating an if expression" =
comm_err(<<"if length([a,b]) > 17 -> a end.">>),
?line "exception error: no such process or port" =
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index 73b282149a..f11c6ec4d6 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2012. 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
@@ -536,7 +536,7 @@ projection(Conf) when is_list(Conf) ->
from_term([], [[atom]]))),
?line {'EXIT', {badarg, _}} =
(catch projection({external, fun(X) -> X end}, from_term([[a]]))),
- ?line eval(projection({sofs,union},
+ ?line eval(projection(fun sofs:union/1,
from_term([[[1,2],[2,3]], [[a,b],[b,c]]])),
from_term([[1,2,3], [a,b,c]])),
?line eval(projection(fun(_) -> from_term([a]) end,
@@ -628,7 +628,7 @@ substitution(Conf) when is_list(Conf) ->
?line {'EXIT', {badarg, _}} =
(catch substitution({external, fun(X) -> X end}, from_term([[a]]))),
?line eval(substitution(fun(X) -> X end, from_term([], [[atom]])), E),
- ?line eval(substitution({sofs,union},
+ ?line eval(substitution(fun sofs:union/1,
from_term([[[1,2],[2,3]], [[a,b],[b,c]]])),
from_term([{[[1,2],[2,3]],[1,2,3]}, {[[a,b],[b,c]],[a,b,c]}])),
?line eval(substitution(fun(_) -> from_term([a]) end,
@@ -745,7 +745,7 @@ restriction(Conf) when is_list(Conf) ->
?line eval(restriction(Id, S3, E), E),
?line eval(restriction(Id, from_term([], [[atom]]), set([a])),
from_term([], [[atom]])),
- ?line eval(restriction({sofs,union},
+ ?line eval(restriction(fun sofs:union/1,
from_term([[[a],[b]], [[b],[c]],
[[], [a,b]], [[1],[2]]]),
from_term([[a,b],[1,2,3],[b,c]])),
@@ -862,7 +862,7 @@ drestriction(Conf) when is_list(Conf) ->
?line eval(drestriction(Id, S3, E), S3),
?line eval(drestriction(Id, from_term([], [[atom]]), set([a])),
from_term([], [[atom]])),
- ?line eval(drestriction({sofs,union},
+ ?line eval(drestriction(fun sofs:union/1,
from_term([[[a],[b]], [[b],[c]],
[[], [a,b]], [[1],[2]]]),
from_term([[a,b],[1,2,3],[b,c]])),
@@ -1028,7 +1028,7 @@ specification(Conf) when is_list(Conf) ->
end,
?line eval(specification({external,Fun2x}, S2), from_term([[1],[3]])),
- Fun3 = fun(_) -> neither_true_or_false end,
+ Fun3 = fun(_) -> neither_true_nor_false end,
?line {'EXIT', {badarg, _}} =
(catch specification(Fun3, set([a]))),
?line {'EXIT', {badarg, _}} =
@@ -1810,8 +1810,8 @@ partition_3(Conf) when is_list(Conf) ->
S12a = from_term([[[a],[b]], [[b],[c]], [[], [a,b]], [[1],[2]]]),
S12b = from_term([[a,b],[1,2,3],[b,c]]),
- ?line eval(partition({sofs,union}, S12a, S12b),
- lpartition({sofs,union}, S12a, S12b)),
+ ?line eval(partition(fun sofs:union/1, S12a, S12b),
+ lpartition(fun sofs:union/1, S12a, S12b)),
Fun13 = fun(_) -> from_term([a]) end,
S13a = from_term([], [[atom]]),
@@ -1879,12 +1879,9 @@ digraph(Conf) when is_list(Conf) ->
?line {'EXIT', {badarg, _}} =
(catch family_to_digraph(set([a]))),
- ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} =
- (catch family_to_digraph(set([a]), [foo])),
- ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} =
- (catch family_to_digraph(F, [foo])),
- ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_],_}|_]}} =
- (catch family_to_digraph(family([{a,[a]}]),[acyclic])),
+ digraph_fail(badarg, catch family_to_digraph(set([a]), [foo])),
+ digraph_fail(badarg, catch family_to_digraph(F, [foo])),
+ digraph_fail(cyclic, catch family_to_digraph(family([{a,[a]}]),[acyclic])),
?line G1 = family_to_digraph(E),
?line {'EXIT', {badarg, _}} = (catch digraph_to_family(G1, foo)),
@@ -1927,6 +1924,13 @@ digraph(Conf) when is_list(Conf) ->
?line true = T0 == ets:all(),
ok.
+digraph_fail(ExitReason, Fail) ->
+ {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail,
+ case {test_server:is_native(sofs),A} of
+ {false,[_,_]} -> ok;
+ {true,2} -> ok
+ end.
+
constant_function(suite) -> [];
constant_function(doc) -> [""];
constant_function(Conf) when is_list(Conf) ->
@@ -1952,10 +1956,8 @@ misc(Conf) when is_list(Conf) ->
% the "functional" part:
?line eval(union(intersection(partition(1,S), partition(Id,S))),
difference(S, RR)),
-
- %% The function external:foo/1 is undefined.
?line {'EXIT', {undef, _}} =
- (catch projection({external,foo}, set([a,b,c]))),
+ (catch projection(fun external:foo/1, set([a,b,c]))),
ok.
relational_restriction(R) ->
@@ -1968,19 +1970,19 @@ family_specification(doc) -> [""];
family_specification(Conf) when is_list(Conf) ->
E = empty_set(),
%% internal
- ?line eval(family_specification({sofs, is_set}, E), E),
+ ?line eval(family_specification(fun sofs:is_set/1, E), E),
?line {'EXIT', {badarg, _}} =
- (catch family_specification({sofs,is_set}, set([]))),
+ (catch family_specification(fun sofs:is_set/1, set([]))),
?line F1 = from_term([{1,[1]}]),
- ?line eval(family_specification({sofs,is_set}, F1), F1),
+ ?line eval(family_specification(fun sofs:is_set/1, F1), F1),
Fun = fun(S) -> is_subset(S, set([0,1,2,3,4])) end,
?line F2 = family([{a,[1,2]},{b,[3,4,5]}]),
?line eval(family_specification(Fun, F2), family([{a,[1,2]}])),
?line F3 = from_term([{a,[]},{b,[]}]),
- ?line eval(family_specification({sofs,is_set}, F3), F3),
+ ?line eval(family_specification(fun sofs:is_set/1, F3), F3),
Fun2 = fun(_) -> throw(fippla) end,
?line fippla = (catch family_specification(Fun2, family([{a,[1]}]))),
- Fun3 = fun(_) -> neither_true_or_false end,
+ Fun3 = fun(_) -> neither_true_nor_false end,
?line {'EXIT', {badarg, _}} =
(catch family_specification(Fun3, F3)),
@@ -2095,22 +2097,22 @@ family_projection(Conf) when is_list(Conf) ->
?line eval(family_projection(fun(X) -> X end, family([])), E),
?line L1 = [{a,[]}],
- ?line eval(family_projection({sofs,union}, E), E),
- ?line eval(family_projection({sofs,union}, from_term(L1, SSType)),
+ ?line eval(family_projection(fun sofs:union/1, E), E),
+ ?line eval(family_projection(fun sofs:union/1, from_term(L1, SSType)),
family(L1)),
?line {'EXIT', {badarg, _}} =
- (catch family_projection({sofs,union}, set([]))),
+ (catch family_projection(fun sofs:union/1, set([]))),
?line {'EXIT', {badarg, _}} =
- (catch family_projection({sofs,union}, from_term([{1,[1]}]))),
+ (catch family_projection(fun sofs:union/1, from_term([{1,[1]}]))),
?line F2 = from_term([{a,[[1],[2]]},{b,[[3,4],[5]]}], SSType),
- ?line eval(family_projection({sofs,union}, F2),
+ ?line eval(family_projection(fun sofs:union/1, F2),
family_union(F2)),
?line F3 = from_term([{1,[{a,b},{b,c},{c,d}]},{3,[]},{5,[{3,5}]}],
SRType),
- ?line eval(family_projection({sofs,domain}, F3), family_domain(F3)),
- ?line eval(family_projection({sofs,range}, F3), family_range(F3)),
+ ?line eval(family_projection(fun sofs:domain/1, F3), family_domain(F3)),
+ ?line eval(family_projection(fun sofs:range/1, F3), family_range(F3)),
?line eval(family_projection(fun(_) -> E end, family([{a,[b,c]}])),
from_term([{a,[]}])),
@@ -2290,7 +2292,7 @@ partition_family(Conf) when is_list(Conf) ->
?line eval(partition_family(1, E), E),
?line eval(partition_family(2, E), E),
- ?line eval(partition_family({sofs,union}, E), E),
+ ?line eval(partition_family(fun sofs:union/1, E), E),
?line eval(partition_family(1, ER), EF),
?line eval(partition_family(2, ER), EF),
?line {'EXIT', {badarg, _}} = (catch partition_family(1, set([]))),
@@ -2354,7 +2356,7 @@ partition_family(Conf) when is_list(Conf) ->
?line {'EXIT', {badarg, _}} =
(catch partition_family({external, fun(X) -> X end},
from_term([[a]]))),
- ?line eval(partition_family({sofs,union},
+ ?line eval(partition_family(fun sofs:union/1,
from_term([[[1],[1,2]], [[1,2]]])),
from_term([{[1,2], [[[1],[1,2]],[[1,2]]]}])),
?line eval(partition_family(fun(X) -> X end,
diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl
index 71b76c093f..767ae3d62c 100644
--- a/lib/stdlib/test/supervisor_SUITE.erl
+++ b/lib/stdlib/test/supervisor_SUITE.erl
@@ -21,7 +21,7 @@
-module(supervisor_SUITE).
-include_lib("common_test/include/ct.hrl").
--define(TIMEOUT, 1000).
+-define(TIMEOUT, ?t:minutes(1)).
%% Testserver specific export
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
@@ -62,7 +62,8 @@
do_not_save_start_parameters_for_temporary_children/1,
do_not_save_child_specs_for_temporary_children/1,
simple_one_for_one_scale_many_temporary_children/1,
- simple_global_supervisor/1]).
+ simple_global_supervisor/1, hanging_restart_loop/1,
+ hanging_restart_loop_simple/1]).
%%-------------------------------------------------------------------------
@@ -82,7 +83,7 @@ all() ->
count_children_memory, do_not_save_start_parameters_for_temporary_children,
do_not_save_child_specs_for_temporary_children,
simple_one_for_one_scale_many_temporary_children, temporary_bystander,
- simple_global_supervisor].
+ simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple].
groups() ->
[{sup_start, [],
@@ -111,10 +112,8 @@ groups() ->
{restart_rest_for_one, [],
[rest_for_one, rest_for_one_escalation]}].
-init_per_suite(Config0) ->
- Config = lists:keydelete(watchdog, 1, Config0),
- Dog = test_server:timetrap(?TIMEOUT),
- [{watchdog, Dog} | Config].
+init_per_suite(Config) ->
+ Config.
end_per_suite(_Config) ->
ok.
@@ -129,18 +128,21 @@ init_per_testcase(count_children_memory, Config) ->
try erlang:memory() of
_ ->
erts_debug:set_internal_state(available_internal_state, true),
- Config
+ Dog = ?t:timetrap(?TIMEOUT),
+ [{watchdog,Dog}|Config]
catch error:notsup ->
{skip, "+Meamin used during test; erlang:memory/1 not available"}
end;
init_per_testcase(_Case, Config) ->
- erlang:display(_Case),
- Config.
+ Dog = ?t:timetrap(?TIMEOUT),
+ [{watchdog,Dog}|Config].
-end_per_testcase(count_children_memory, _Config) ->
+end_per_testcase(count_children_memory, Config) ->
catch erts_debug:set_internal_state(available_internal_state, false),
+ ?t:timetrap_cancel(?config(watchdog,Config)),
ok;
-end_per_testcase(_Case, _Config) ->
+end_per_testcase(_Case, Config) ->
+ ?t:timetrap_cancel(?config(watchdog,Config)),
ok.
start_link(InitResult) ->
@@ -1455,6 +1457,102 @@ gen_server9212() ->
%%-------------------------------------------------------------------------
+%% Test that child and supervisor can be shutdown while hanging in restart loop.
+%% See OTP-9549.
+hanging_restart_loop(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ {ok, Pid} = start_link({ok, {{one_for_one, 8, 10}, []}}),
+ Child1 = {child1, {supervisor_deadlock, start_child, []},
+ permanent, brutal_kill, worker, []},
+
+ %% Ets table with state read by supervisor_deadlock.erl
+ ets:new(supervisor_deadlock,[set,named_table,public]),
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+
+ {ok, CPid1} = supervisor:start_child(sup_test, Child1),
+ link(CPid1),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ {error, already_present} = supervisor:start_child(sup_test, Child1),
+ {error, restarting} = supervisor:restart_child(sup_test, child1),
+ {error, restarting} = supervisor:delete_child(sup_test, child1),
+ [{child1,restarting,worker,[]}] = supervisor:which_children(sup_test),
+ [1,0,0,1] = get_child_counts(sup_test),
+
+ ok = supervisor:terminate_child(sup_test, child1),
+ check_exit_reason(CPid1, error),
+ [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test),
+
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+ {ok, CPid2} = supervisor:restart_child(sup_test, child1),
+ link(CPid2),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ %% Terminating supervisor.
+ %% OTP-9549 fixes so this does not give a timetrap timeout -
+ %% i.e. that supervisor does not hang in restart loop.
+ terminate(Pid,shutdown),
+
+ %% Check that child died with reason from 'restart' request above
+ check_exit_reason(CPid2, error),
+ undefined = whereis(sup_test),
+ ok.
+
+%%-------------------------------------------------------------------------
+%% Test that child and supervisor can be shutdown while hanging in
+%% restart loop, simple_one_for_one.
+%% See OTP-9549.
+hanging_restart_loop_simple(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ Child1 = {child1, {supervisor_deadlock, start_child, []},
+ permanent, brutal_kill, worker, []},
+ {ok, Pid} = start_link({ok, {{simple_one_for_one, 8, 10}, [Child1]}}),
+
+ %% Ets table with state read by supervisor_deadlock.erl
+ ets:new(supervisor_deadlock,[set,named_table,public]),
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+
+ {ok, CPid1} = supervisor:start_child(sup_test, []),
+ link(CPid1),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ {error, simple_one_for_one} = supervisor:restart_child(sup_test, child1),
+ {error, simple_one_for_one} = supervisor:delete_child(sup_test, child1),
+ [{undefined,restarting,worker,[]}] = supervisor:which_children(sup_test),
+ [1,0,0,1] = get_child_counts(sup_test),
+
+ ok = supervisor:terminate_child(sup_test, CPid1),
+ check_exit_reason(CPid1, error),
+ [] = supervisor:which_children(sup_test),
+
+ ets:insert(supervisor_deadlock,{fail_start,false}),
+ {ok, CPid2} = supervisor:start_child(sup_test, []),
+ link(CPid2),
+
+ ets:insert(supervisor_deadlock,{fail_start,true}),
+ supervisor_deadlock:restart_child(),
+ timer:sleep(2000), % allow restart to happen before proceeding
+
+ %% Terminating supervisor.
+ %% OTP-9549 fixes so this does not give a timetrap timeout -
+ %% i.e. that supervisor does not hang in restart loop.
+ terminate(Pid,shutdown),
+
+ %% Check that child died with reason from 'restart' request above
+ check_exit_reason(CPid2, error),
+ undefined = whereis(sup_test),
+ ok.
+
+%%-------------------------------------------------------------------------
terminate(Pid, Reason) when Reason =/= supervisor ->
terminate(dummy, Pid, dummy, Reason).
diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl
new file mode 100644
index 0000000000..288547a972
--- /dev/null
+++ b/lib/stdlib/test/supervisor_deadlock.erl
@@ -0,0 +1,45 @@
+-module(supervisor_deadlock).
+-compile(export_all).
+
+
+%%%-----------------------------------------------------------------
+%%% gen_server callbacks
+init([child]) ->
+ case ets:lookup(supervisor_deadlock,fail_start) of
+ [{fail_start, false}] ->
+ %% we must not fail on the first init, otherwise supervisor
+ %% terminates immediately
+ {ok, []};
+ [{fail_start, true}] ->
+ %% Restart frequency is MaxR=8, MaxT=10, so this will
+ %% ensure that restart intensity is not reached -> restart
+ %% loop
+ timer:sleep(2000), % NOTE: this could be a gen_server call timeout
+
+ {stop, error}
+ end.
+
+handle_call(_Req, _From, State) ->
+ {reply, ok, State}.
+
+%% Force a restart
+handle_cast(restart, State) ->
+ {stop, error, State}.
+
+handle_info(_Msg, State) ->
+ {noreply, State}.
+
+terminate(_Reason, _State) ->
+ ok.
+
+code_change(_OldVsn, State, _Extra) ->
+ {ok, State}.
+
+
+%%%-----------------------------------------------------------------
+%%% Start child
+start_child() ->
+ gen_server:start_link({local, ?MODULE}, ?MODULE, [child], []).
+
+restart_child() ->
+ gen_server:cast(supervisor_deadlock, restart).
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-11 20:49:44 +0000